LCOV - code coverage report
Current view: top level - gcc/fortran - trans-openmp.cc (source / functions) Coverage Total Hit
Test: gcc.info Lines: 96.1 % 5051 4853
Test Date: 2023-09-09 13:19:57 Functions: 100.0 % 93 93
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-2023 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 "constructor.h"
      39                 :             : #include "gomp-constants.h"
      40                 :             : #include "omp-general.h"
      41                 :             : #include "omp-low.h"
      42                 :             : #include "memmodel.h"  /* For MEMMODEL_ enums.  */
      43                 :             : 
      44                 :             : #undef GCC_DIAG_STYLE
      45                 :             : #define GCC_DIAG_STYLE __gcc_tdiag__
      46                 :             : #include "diagnostic-core.h"
      47                 :             : #undef GCC_DIAG_STYLE
      48                 :             : #define GCC_DIAG_STYLE __gcc_gfc__
      49                 :             : #include "attribs.h"
      50                 :             : #include "function.h"
      51                 :             : 
      52                 :             : int ompws_flags;
      53                 :             : 
      54                 :             : /* True if OpenMP should regard this DECL as being a scalar which has Fortran's
      55                 :             :    allocatable or pointer attribute.  */
      56                 :             : 
      57                 :             : bool
      58                 :        5911 : gfc_omp_is_allocatable_or_ptr (const_tree decl)
      59                 :             : {
      60                 :        5911 :   return (DECL_P (decl)
      61                 :        5911 :           && (GFC_DECL_GET_SCALAR_POINTER (decl)
      62                 :        4180 :               || GFC_DECL_GET_SCALAR_ALLOCATABLE (decl)));
      63                 :             : }
      64                 :             : 
      65                 :             : /* True if the argument is an optional argument; except that false is also
      66                 :             :    returned for arguments with the value attribute (nonpointers) and for
      67                 :             :    assumed-shape variables (decl is a local variable containing arg->data).
      68                 :             :    Note that for 'procedure(), optional' the value false is used as that's
      69                 :             :    always a pointer and no additional indirection is used.
      70                 :             :    Note that pvoid_type_node is for 'type(c_ptr), value' (and c_funloc).  */
      71                 :             : 
      72                 :             : static bool
      73                 :       43904 : gfc_omp_is_optional_argument (const_tree decl)
      74                 :             : {
      75                 :             :   /* Note: VAR_DECL can occur with BIND(C) and array descriptors.  */
      76                 :       28971 :   return ((TREE_CODE (decl) == PARM_DECL || VAR_P (decl))
      77                 :       43904 :           && DECL_LANG_SPECIFIC (decl)
      78                 :       20149 :           && TREE_CODE (TREE_TYPE (decl)) == POINTER_TYPE
      79                 :       19967 :           && !VOID_TYPE_P (TREE_TYPE (TREE_TYPE (decl)))
      80                 :       19736 :           && TREE_CODE (TREE_TYPE (TREE_TYPE (decl))) != FUNCTION_TYPE
      81                 :       63616 :           && GFC_DECL_OPTIONAL_ARGUMENT (decl));
      82                 :             : }
      83                 :             : 
      84                 :             : /* Check whether this DECL belongs to a Fortran optional argument.
      85                 :             :    With 'for_present_check' set to false, decls which are optional parameters
      86                 :             :    themselves are returned as tree - or a NULL_TREE otherwise. Those decls are
      87                 :             :    always pointers.  With 'for_present_check' set to true, the decl for checking
      88                 :             :    whether an argument is present is returned; for arguments with value
      89                 :             :    attribute this is the hidden argument and of BOOLEAN_TYPE.  If the decl is
      90                 :             :    unrelated to optional arguments, NULL_TREE is returned.  */
      91                 :             : 
      92                 :             : tree
      93                 :       20449 : gfc_omp_check_optional_argument (tree decl, bool for_present_check)
      94                 :             : {
      95                 :       20449 :   if (!for_present_check)
      96                 :        2002 :     return gfc_omp_is_optional_argument (decl) ? decl : NULL_TREE;
      97                 :             : 
      98                 :       18447 :   if (!DECL_LANG_SPECIFIC (decl))
      99                 :             :     return NULL_TREE;
     100                 :             : 
     101                 :        5010 :   tree orig_decl = decl;
     102                 :             : 
     103                 :             :   /* For assumed-shape arrays, a local decl with arg->data is used.  */
     104                 :        5010 :   if (TREE_CODE (decl) != PARM_DECL
     105                 :        5010 :       && (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (decl))
     106                 :        1646 :           || GFC_ARRAY_TYPE_P (TREE_TYPE (decl))))
     107                 :         722 :     decl = GFC_DECL_SAVED_DESCRIPTOR (decl);
     108                 :             : 
     109                 :             :   /* Note: With BIND(C), array descriptors are converted to a VAR_DECL.  */
     110                 :        5010 :   if (decl == NULL_TREE
     111                 :        4891 :       || (TREE_CODE (decl) != PARM_DECL && TREE_CODE (decl) != VAR_DECL)
     112                 :        4891 :       || !DECL_LANG_SPECIFIC (decl)
     113                 :        9499 :       || !GFC_DECL_OPTIONAL_ARGUMENT (decl))
     114                 :             :     return NULL_TREE;
     115                 :             : 
     116                 :             :    /* Scalars with VALUE attribute which are passed by value use a hidden
     117                 :             :       argument to denote the present status.  They are passed as nonpointer type
     118                 :             :       with one exception: 'type(c_ptr), value' as 'void*'.  */
     119                 :             :    /* Cf. trans-expr.cc's gfc_conv_expr_present.  */
     120                 :        2810 :    if (TREE_CODE (TREE_TYPE (decl)) != POINTER_TYPE
     121                 :        2810 :        || VOID_TYPE_P (TREE_TYPE (TREE_TYPE (decl))))
     122                 :             :     {
     123                 :         205 :       char name[GFC_MAX_SYMBOL_LEN + 2];
     124                 :         205 :       tree tree_name;
     125                 :             : 
     126                 :         205 :       name[0] = '.';
     127                 :         205 :       strcpy (&name[1], IDENTIFIER_POINTER (DECL_NAME (decl)));
     128                 :         205 :       tree_name = get_identifier (name);
     129                 :             : 
     130                 :             :       /* Walk function argument list to find the hidden arg.  */
     131                 :         205 :       decl = DECL_ARGUMENTS (DECL_CONTEXT (decl));
     132                 :        1437 :       for ( ; decl != NULL_TREE; decl = TREE_CHAIN (decl))
     133                 :        1437 :         if (DECL_NAME (decl) == tree_name
     134                 :        1437 :             && DECL_ARTIFICIAL (decl))
     135                 :             :           break;
     136                 :             : 
     137                 :         205 :       gcc_assert (decl);
     138                 :         205 :       return decl;
     139                 :             :     }
     140                 :             : 
     141                 :        2605 :   return fold_build2_loc (input_location, NE_EXPR, boolean_type_node,
     142                 :        2605 :                           orig_decl, null_pointer_node);
     143                 :             : }
     144                 :             : 
     145                 :             : 
     146                 :             : /* Returns tree with NULL if it is not an array descriptor and with the tree to
     147                 :             :    access the 'data' component otherwise.  With type_only = true, it returns the
     148                 :             :    TREE_TYPE without creating a new tree.  */
     149                 :             : 
     150                 :             : tree
     151                 :       17070 : gfc_omp_array_data (tree decl, bool type_only)
     152                 :             : {
     153                 :       17070 :   tree type = TREE_TYPE (decl);
     154                 :             : 
     155                 :       17070 :   if (POINTER_TYPE_P (type))
     156                 :        9925 :     type = TREE_TYPE (type);
     157                 :             : 
     158                 :       17070 :   if (!GFC_DESCRIPTOR_TYPE_P (type))
     159                 :             :     return NULL_TREE;
     160                 :             : 
     161                 :        4532 :   if (type_only)
     162                 :        3314 :     return GFC_TYPE_ARRAY_DATAPTR_TYPE (type);
     163                 :             : 
     164                 :        1218 :   if (POINTER_TYPE_P (TREE_TYPE (decl)))
     165                 :         414 :     decl = build_fold_indirect_ref (decl);
     166                 :             : 
     167                 :        1218 :   decl = gfc_conv_descriptor_data_get (decl);
     168                 :        1218 :   STRIP_NOPS (decl);
     169                 :        1218 :   return decl;
     170                 :             : }
     171                 :             : 
     172                 :             : /* Return the byte-size of the passed array descriptor. */
     173                 :             : 
     174                 :             : tree
     175                 :          18 : gfc_omp_array_size (tree decl, gimple_seq *pre_p)
     176                 :             : {
     177                 :          18 :   stmtblock_t block;
     178                 :          18 :   if (POINTER_TYPE_P (TREE_TYPE (decl)))
     179                 :          18 :     decl = build_fold_indirect_ref (decl);
     180                 :          18 :   tree type = TREE_TYPE (decl);
     181                 :          18 :   gcc_assert (GFC_DESCRIPTOR_TYPE_P (type));
     182                 :          18 :   bool allocatable = (GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_ALLOCATABLE
     183                 :           2 :                       || GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_POINTER
     184                 :          18 :                       || GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_POINTER_CONT);
     185                 :          18 :   gfc_init_block (&block);
     186                 :          54 :   tree size = gfc_full_array_size (&block, decl,
     187                 :          18 :                                    GFC_TYPE_ARRAY_RANK (TREE_TYPE (decl)));
     188                 :          18 :   size = fold_convert (size_type_node, size);
     189                 :          18 :   tree elemsz = gfc_get_element_type (TREE_TYPE (decl));
     190                 :          18 :   if (TREE_CODE (elemsz) == ARRAY_TYPE && TYPE_STRING_FLAG (elemsz))
     191                 :           6 :     elemsz = gfc_conv_descriptor_elem_len (decl);
     192                 :             :   else
     193                 :          12 :     elemsz = TYPE_SIZE_UNIT (elemsz);
     194                 :          18 :   size = fold_build2 (MULT_EXPR, size_type_node, size, elemsz);
     195                 :          18 :   if (!allocatable)
     196                 :           0 :     gimplify_and_add (gfc_finish_block (&block), pre_p);
     197                 :             :   else
     198                 :             :     {
     199                 :          18 :       tree var = create_tmp_var (size_type_node);
     200                 :          18 :       gfc_add_expr_to_block (&block, build2 (MODIFY_EXPR, sizetype, var, size));
     201                 :          18 :       tree tmp = fold_build2_loc (input_location, NE_EXPR, boolean_type_node,
     202                 :             :                                   gfc_conv_descriptor_data_get (decl),
     203                 :             :                                   null_pointer_node);
     204                 :          18 :       tmp = build3_loc (input_location, COND_EXPR, void_type_node, tmp,
     205                 :             :                         gfc_finish_block (&block),
     206                 :             :                         build2 (MODIFY_EXPR, sizetype, var, size_zero_node));
     207                 :          18 :       gimplify_and_add (tmp, pre_p);
     208                 :          18 :       size = var;
     209                 :             :     }
     210                 :          18 :   return size;
     211                 :             : }
     212                 :             : 
     213                 :             : 
     214                 :             : /* True if OpenMP should privatize what this DECL points to rather
     215                 :             :    than the DECL itself.  */
     216                 :             : 
     217                 :             : bool
     218                 :      431809 : gfc_omp_privatize_by_reference (const_tree decl)
     219                 :             : {
     220                 :      431809 :   tree type = TREE_TYPE (decl);
     221                 :             : 
     222                 :      431809 :   if (TREE_CODE (type) == REFERENCE_TYPE
     223                 :      431809 :       && (!DECL_ARTIFICIAL (decl) || TREE_CODE (decl) == PARM_DECL))
     224                 :             :     return true;
     225                 :             : 
     226                 :      409468 :   if (TREE_CODE (type) == POINTER_TYPE
     227                 :      409468 :       && gfc_omp_is_optional_argument (decl))
     228                 :             :     return true;
     229                 :             : 
     230                 :      400420 :   if (TREE_CODE (type) == POINTER_TYPE)
     231                 :             :     {
     232                 :       30823 :       while (TREE_CODE (decl) == COMPONENT_REF)
     233                 :           0 :         decl = TREE_OPERAND (decl, 1);
     234                 :             : 
     235                 :             :       /* Array POINTER/ALLOCATABLE have aggregate types, all user variables
     236                 :             :          that have POINTER_TYPE type and aren't scalar pointers, scalar
     237                 :             :          allocatables, Cray pointees or C pointers are supposed to be
     238                 :             :          privatized by reference.  */
     239                 :       30823 :       if (GFC_DECL_GET_SCALAR_POINTER (decl)
     240                 :       29333 :           || GFC_DECL_GET_SCALAR_ALLOCATABLE (decl)
     241                 :       27096 :           || GFC_DECL_CRAY_POINTEE (decl)
     242                 :       27090 :           || GFC_DECL_ASSOCIATE_VAR_P (decl)
     243                 :       35931 :           || VOID_TYPE_P (TREE_TYPE (TREE_TYPE (decl))))
     244                 :             :         return false;
     245                 :             : 
     246                 :       19420 :       if (!DECL_ARTIFICIAL (decl)
     247                 :       19420 :           && TREE_CODE (TREE_TYPE (type)) != FUNCTION_TYPE)
     248                 :             :         return true;
     249                 :             : 
     250                 :             :       /* Some arrays are expanded as DECL_ARTIFICIAL pointers
     251                 :             :          by the frontend.  */
     252                 :       12678 :       if (DECL_LANG_SPECIFIC (decl)
     253                 :       12678 :           && GFC_DECL_SAVED_DESCRIPTOR (decl))
     254                 :             :         return true;
     255                 :             :     }
     256                 :             : 
     257                 :             :   return false;
     258                 :             : }
     259                 :             : 
     260                 :             : /* OMP_CLAUSE_DEFAULT_UNSPECIFIED unless OpenMP sharing attribute
     261                 :             :    of DECL is predetermined.  */
     262                 :             : 
     263                 :             : enum omp_clause_default_kind
     264                 :        7397 : gfc_omp_predetermined_sharing (tree decl)
     265                 :             : {
     266                 :             :   /* Associate names preserve the association established during ASSOCIATE.
     267                 :             :      As they are implemented either as pointers to the selector or array
     268                 :             :      descriptor and shouldn't really change in the ASSOCIATE region,
     269                 :             :      this decl can be either shared or firstprivate.  If it is a pointer,
     270                 :             :      use firstprivate, as it is cheaper that way, otherwise make it shared.  */
     271                 :        7397 :   if (GFC_DECL_ASSOCIATE_VAR_P (decl))
     272                 :             :     {
     273                 :          45 :       if (TREE_CODE (TREE_TYPE (decl)) == POINTER_TYPE)
     274                 :             :         return OMP_CLAUSE_DEFAULT_FIRSTPRIVATE;
     275                 :             :       else
     276                 :          18 :         return OMP_CLAUSE_DEFAULT_SHARED;
     277                 :             :     }
     278                 :             : 
     279                 :        7352 :   if (DECL_ARTIFICIAL (decl)
     280                 :        1338 :       && ! GFC_DECL_RESULT (decl)
     281                 :        8690 :       && ! (DECL_LANG_SPECIFIC (decl)
     282                 :         156 :             && GFC_DECL_SAVED_DESCRIPTOR (decl)))
     283                 :             :     return OMP_CLAUSE_DEFAULT_SHARED;
     284                 :             : 
     285                 :             :   /* Cray pointees shouldn't be listed in any clauses and should be
     286                 :             :      gimplified to dereference of the corresponding Cray pointer.
     287                 :             :      Make them all private, so that they are emitted in the debug
     288                 :             :      information.  */
     289                 :        6146 :   if (GFC_DECL_CRAY_POINTEE (decl))
     290                 :             :     return OMP_CLAUSE_DEFAULT_PRIVATE;
     291                 :             : 
     292                 :             :   /* Assumed-size arrays are predetermined shared.  */
     293                 :        6110 :   if (TREE_CODE (decl) == PARM_DECL
     294                 :        1476 :       && GFC_ARRAY_TYPE_P (TREE_TYPE (decl))
     295                 :         507 :       && GFC_TYPE_ARRAY_AKIND (TREE_TYPE (decl)) == GFC_ARRAY_UNKNOWN
     296                 :        6617 :       && GFC_TYPE_ARRAY_UBOUND (TREE_TYPE (decl),
     297                 :             :                                 GFC_TYPE_ARRAY_RANK (TREE_TYPE (decl)) - 1)
     298                 :             :          == NULL)
     299                 :             :     return OMP_CLAUSE_DEFAULT_SHARED;
     300                 :             : 
     301                 :             :   /* Dummy procedures aren't considered variables by OpenMP, thus are
     302                 :             :      disallowed in OpenMP clauses.  They are represented as PARM_DECLs
     303                 :             :      in the middle-end, so return OMP_CLAUSE_DEFAULT_FIRSTPRIVATE here
     304                 :             :      to avoid complaining about their uses with default(none).  */
     305                 :        6042 :   if (TREE_CODE (decl) == PARM_DECL
     306                 :        1408 :       && TREE_CODE (TREE_TYPE (decl)) == POINTER_TYPE
     307                 :        6574 :       && TREE_CODE (TREE_TYPE (TREE_TYPE (decl))) == FUNCTION_TYPE)
     308                 :             :     return OMP_CLAUSE_DEFAULT_FIRSTPRIVATE;
     309                 :             : 
     310                 :             :   /* COMMON and EQUIVALENCE decls are shared.  They
     311                 :             :      are only referenced through DECL_VALUE_EXPR of the variables
     312                 :             :      contained in them.  If those are privatized, they will not be
     313                 :             :      gimplified to the COMMON or EQUIVALENCE decls.  */
     314                 :        6028 :   if (GFC_DECL_COMMON_OR_EQUIV (decl) && ! DECL_HAS_VALUE_EXPR_P (decl))
     315                 :             :     return OMP_CLAUSE_DEFAULT_SHARED;
     316                 :             : 
     317                 :        5999 :   if (GFC_DECL_RESULT (decl) && ! DECL_HAS_VALUE_EXPR_P (decl))
     318                 :             :     return OMP_CLAUSE_DEFAULT_SHARED;
     319                 :             : 
     320                 :             :   /* These are either array or derived parameters, or vtables.
     321                 :             :      In the former cases, the OpenMP standard doesn't consider them to be
     322                 :             :      variables at all (they can't be redefined), but they can nevertheless appear
     323                 :             :      in parallel/task regions and for default(none) purposes treat them as shared.
     324                 :             :      For vtables likely the same handling is desirable.  */
     325                 :        4605 :   if (VAR_P (decl) && TREE_READONLY (decl)
     326                 :        6002 :       && (TREE_STATIC (decl) || DECL_EXTERNAL (decl)))
     327                 :           3 :     return OMP_CLAUSE_DEFAULT_SHARED;
     328                 :             : 
     329                 :             :   return OMP_CLAUSE_DEFAULT_UNSPECIFIED;
     330                 :             : }
     331                 :             : 
     332                 :             : 
     333                 :             : /* OMP_CLAUSE_DEFAULTMAP_CATEGORY_UNSPECIFIED unless OpenMP mapping attribute
     334                 :             :    of DECL is predetermined.  */
     335                 :             : 
     336                 :             : enum omp_clause_defaultmap_kind
     337                 :        3458 : gfc_omp_predetermined_mapping (tree decl)
     338                 :             : {
     339                 :        3458 :   if (DECL_ARTIFICIAL (decl)
     340                 :         812 :       && ! GFC_DECL_RESULT (decl)
     341                 :        4270 :       && ! (DECL_LANG_SPECIFIC (decl)
     342                 :          64 :             && GFC_DECL_SAVED_DESCRIPTOR (decl)))
     343                 :             :     return OMP_CLAUSE_DEFAULTMAP_TO;
     344                 :             : 
     345                 :             :   /* These are either array or derived parameters, or vtables.  */
     346                 :        1002 :   if (VAR_P (decl) && TREE_READONLY (decl)
     347                 :        2686 :       && (TREE_STATIC (decl) || DECL_EXTERNAL (decl)))
     348                 :             :     return OMP_CLAUSE_DEFAULTMAP_TO;
     349                 :             : 
     350                 :             :   return OMP_CLAUSE_DEFAULTMAP_CATEGORY_UNSPECIFIED;
     351                 :             : }
     352                 :             : 
     353                 :             : 
     354                 :             : /* Return decl that should be used when reporting DEFAULT(NONE)
     355                 :             :    diagnostics.  */
     356                 :             : 
     357                 :             : tree
     358                 :         104 : gfc_omp_report_decl (tree decl)
     359                 :             : {
     360                 :         104 :   if (DECL_ARTIFICIAL (decl)
     361                 :           3 :       && DECL_LANG_SPECIFIC (decl)
     362                 :         107 :       && GFC_DECL_SAVED_DESCRIPTOR (decl))
     363                 :           3 :     return GFC_DECL_SAVED_DESCRIPTOR (decl);
     364                 :             : 
     365                 :             :   return decl;
     366                 :             : }
     367                 :             : 
     368                 :             : /* Return true if TYPE has any allocatable components.  */
     369                 :             : 
     370                 :             : static bool
     371                 :       91754 : gfc_has_alloc_comps (tree type, tree decl)
     372                 :             : {
     373                 :       91754 :   tree field, ftype;
     374                 :             : 
     375                 :       91754 :   if (POINTER_TYPE_P (type))
     376                 :             :     {
     377                 :        3077 :       if (GFC_DECL_GET_SCALAR_ALLOCATABLE (decl))
     378                 :        2313 :         type = TREE_TYPE (type);
     379                 :         764 :       else if (GFC_DECL_GET_SCALAR_POINTER (decl))
     380                 :             :         return false;
     381                 :             :     }
     382                 :             : 
     383                 :       91621 :   if (GFC_DESCRIPTOR_TYPE_P (type)
     384                 :       91621 :       && (GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_POINTER
     385                 :        2886 :           || GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_POINTER_CONT))
     386                 :             :     return false;
     387                 :             : 
     388                 :       91512 :   if (GFC_DESCRIPTOR_TYPE_P (type) || GFC_ARRAY_TYPE_P (type))
     389                 :        6533 :     type = gfc_get_element_type (type);
     390                 :             : 
     391                 :       91512 :   if (TREE_CODE (type) != RECORD_TYPE)
     392                 :             :     return false;
     393                 :             : 
     394                 :        6057 :   for (field = TYPE_FIELDS (type); field; field = DECL_CHAIN (field))
     395                 :             :     {
     396                 :        5572 :       ftype = TREE_TYPE (field);
     397                 :        5572 :       if (GFC_DECL_GET_SCALAR_ALLOCATABLE (field))
     398                 :             :         return true;
     399                 :        5570 :       if (GFC_DESCRIPTOR_TYPE_P (ftype)
     400                 :        5570 :           && GFC_TYPE_ARRAY_AKIND (ftype) == GFC_ARRAY_ALLOCATABLE)
     401                 :             :         return true;
     402                 :        3842 :       if (gfc_has_alloc_comps (ftype, field))
     403                 :             :         return true;
     404                 :             :     }
     405                 :             :   return false;
     406                 :             : }
     407                 :             : 
     408                 :             : /* Return true if TYPE is polymorphic but not with pointer attribute.  */
     409                 :             : 
     410                 :             : static bool
     411                 :       39296 : gfc_is_polymorphic_nonptr (tree type)
     412                 :             : {
     413                 :       39296 :   if (POINTER_TYPE_P (type))
     414                 :        3307 :     type = TREE_TYPE (type);
     415                 :       39296 :   return GFC_CLASS_TYPE_P (type);
     416                 :             : }
     417                 :             : 
     418                 :             : /* Return true if TYPE is unlimited polymorphic but not with pointer attribute;
     419                 :             :    unlimited means also intrinsic types are handled and _len is used.  */
     420                 :             : 
     421                 :             : static bool
     422                 :          36 : gfc_is_unlimited_polymorphic_nonptr (tree type)
     423                 :             : {
     424                 :          36 :   if (POINTER_TYPE_P (type))
     425                 :           0 :     type = TREE_TYPE (type);
     426                 :          36 :   if (!GFC_CLASS_TYPE_P (type))
     427                 :             :     return false;
     428                 :             : 
     429                 :          36 :   tree field = TYPE_FIELDS (type); /* _data */
     430                 :          36 :   gcc_assert (field);
     431                 :          36 :   field = DECL_CHAIN (field); /* _vptr */
     432                 :          36 :   gcc_assert (field);
     433                 :          36 :   field = DECL_CHAIN (field);
     434                 :          36 :   if (!field)
     435                 :             :     return false;
     436                 :          24 :   gcc_assert (strcmp ("_len", IDENTIFIER_POINTER (DECL_NAME (field))) == 0);
     437                 :             :   return true;
     438                 :             : }
     439                 :             : 
     440                 :             : /* Return true if the DECL is for an allocatable array or scalar.  */
     441                 :             : 
     442                 :             : bool
     443                 :        3458 : gfc_omp_allocatable_p (tree decl)
     444                 :             : {
     445                 :        3458 :   if (!DECL_P (decl))
     446                 :             :     return false;
     447                 :             : 
     448                 :        3458 :   if (GFC_DECL_GET_SCALAR_ALLOCATABLE (decl))
     449                 :             :     return true;
     450                 :             : 
     451                 :        3261 :   tree type = TREE_TYPE (decl);
     452                 :        3261 :   if (gfc_omp_privatize_by_reference (decl))
     453                 :        1677 :     type = TREE_TYPE (type);
     454                 :             : 
     455                 :        3261 :   if (GFC_DESCRIPTOR_TYPE_P (type)
     456                 :        3261 :       && GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_ALLOCATABLE)
     457                 :             :     return true;
     458                 :             : 
     459                 :             :   return false;
     460                 :             : }
     461                 :             : 
     462                 :             : 
     463                 :             : /* Return true if DECL in private clause needs
     464                 :             :    OMP_CLAUSE_PRIVATE_OUTER_REF on the private clause.  */
     465                 :             : bool
     466                 :       13361 : gfc_omp_private_outer_ref (tree decl)
     467                 :             : {
     468                 :       13361 :   tree type = TREE_TYPE (decl);
     469                 :             : 
     470                 :       13361 :   if (gfc_omp_privatize_by_reference (decl))
     471                 :         611 :     type = TREE_TYPE (type);
     472                 :             : 
     473                 :       13361 :   if (GFC_DESCRIPTOR_TYPE_P (type)
     474                 :       13361 :       && GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_ALLOCATABLE)
     475                 :             :     return true;
     476                 :             : 
     477                 :       13235 :   if (GFC_DECL_GET_SCALAR_ALLOCATABLE (decl))
     478                 :             :     return true;
     479                 :             : 
     480                 :       13149 :   if (gfc_has_alloc_comps (type, decl))
     481                 :             :     return true;
     482                 :             : 
     483                 :             :   return false;
     484                 :             : }
     485                 :             : 
     486                 :             : /* Callback for gfc_omp_unshare_expr.  */
     487                 :             : 
     488                 :             : static tree
     489                 :       92286 : gfc_omp_unshare_expr_r (tree *tp, int *walk_subtrees, void *)
     490                 :             : {
     491                 :       92286 :   tree t = *tp;
     492                 :       92286 :   enum tree_code code = TREE_CODE (t);
     493                 :             : 
     494                 :             :   /* Stop at types, decls, constants like copy_tree_r.  */
     495                 :       92286 :   if (TREE_CODE_CLASS (code) == tcc_type
     496                 :             :       || TREE_CODE_CLASS (code) == tcc_declaration
     497                 :       92286 :       || TREE_CODE_CLASS (code) == tcc_constant
     498                 :       61181 :       || code == BLOCK)
     499                 :       31105 :     *walk_subtrees = 0;
     500                 :       61181 :   else if (handled_component_p (t)
     501                 :       46252 :            || TREE_CODE (t) == MEM_REF)
     502                 :             :     {
     503                 :       14989 :       *tp = unshare_expr (t);
     504                 :       14989 :       *walk_subtrees = 0;
     505                 :             :     }
     506                 :             : 
     507                 :       92286 :   return NULL_TREE;
     508                 :             : }
     509                 :             : 
     510                 :             : /* Unshare in expr anything that the FE which normally doesn't
     511                 :             :    care much about tree sharing (because during gimplification
     512                 :             :    everything is unshared) could cause problems with tree sharing
     513                 :             :    at omp-low.cc time.  */
     514                 :             : 
     515                 :             : static tree
     516                 :        5067 : gfc_omp_unshare_expr (tree expr)
     517                 :             : {
     518                 :        5067 :   walk_tree (&expr, gfc_omp_unshare_expr_r, NULL, NULL);
     519                 :        5067 :   return expr;
     520                 :             : }
     521                 :             : 
     522                 :             : enum walk_alloc_comps
     523                 :             : {
     524                 :             :   WALK_ALLOC_COMPS_DTOR,
     525                 :             :   WALK_ALLOC_COMPS_DEFAULT_CTOR,
     526                 :             :   WALK_ALLOC_COMPS_COPY_CTOR
     527                 :             : };
     528                 :             : 
     529                 :             : /* Handle allocatable components in OpenMP clauses.  */
     530                 :             : 
     531                 :             : static tree
     532                 :        2801 : gfc_walk_alloc_comps (tree decl, tree dest, tree var,
     533                 :             :                       enum walk_alloc_comps kind)
     534                 :             : {
     535                 :        2801 :   stmtblock_t block, tmpblock;
     536                 :        2801 :   tree type = TREE_TYPE (decl), then_b, tem, field;
     537                 :        2801 :   gfc_init_block (&block);
     538                 :             : 
     539                 :        2801 :   if (GFC_ARRAY_TYPE_P (type) || GFC_DESCRIPTOR_TYPE_P (type))
     540                 :             :     {
     541                 :        1092 :       if (GFC_DESCRIPTOR_TYPE_P (type))
     542                 :             :         {
     543                 :         548 :           gfc_init_block (&tmpblock);
     544                 :        1644 :           tem = gfc_full_array_size (&tmpblock, decl,
     545                 :         548 :                                      GFC_TYPE_ARRAY_RANK (type));
     546                 :         548 :           then_b = gfc_finish_block (&tmpblock);
     547                 :         548 :           gfc_add_expr_to_block (&block, gfc_omp_unshare_expr (then_b));
     548                 :         548 :           tem = gfc_omp_unshare_expr (tem);
     549                 :         548 :           tem = fold_build2_loc (input_location, MINUS_EXPR,
     550                 :             :                                  gfc_array_index_type, tem,
     551                 :             :                                  gfc_index_one_node);
     552                 :             :         }
     553                 :             :       else
     554                 :             :         {
     555                 :         544 :           bool compute_nelts = false;
     556                 :         544 :           if (!TYPE_DOMAIN (type)
     557                 :         544 :               || TYPE_MAX_VALUE (TYPE_DOMAIN (type)) == NULL_TREE
     558                 :         544 :               || TYPE_MIN_VALUE (TYPE_DOMAIN (type)) == error_mark_node
     559                 :        1088 :               || TYPE_MAX_VALUE (TYPE_DOMAIN (type)) == error_mark_node)
     560                 :             :             compute_nelts = true;
     561                 :         544 :           else if (VAR_P (TYPE_MAX_VALUE (TYPE_DOMAIN (type))))
     562                 :             :             {
     563                 :          80 :               tree a = DECL_ATTRIBUTES (TYPE_MAX_VALUE (TYPE_DOMAIN (type)));
     564                 :          80 :               if (lookup_attribute ("omp dummy var", a))
     565                 :             :                 compute_nelts = true;
     566                 :             :             }
     567                 :             :           if (compute_nelts)
     568                 :             :             {
     569                 :          80 :               tem = fold_build2 (EXACT_DIV_EXPR, sizetype,
     570                 :             :                                  TYPE_SIZE_UNIT (type),
     571                 :             :                                  TYPE_SIZE_UNIT (TREE_TYPE (type)));
     572                 :          80 :               tem = size_binop (MINUS_EXPR, tem, size_one_node);
     573                 :             :             }
     574                 :             :           else
     575                 :         464 :             tem = array_type_nelts (type);
     576                 :         544 :           tem = fold_convert (gfc_array_index_type, tem);
     577                 :             :         }
     578                 :             : 
     579                 :        1092 :       tree nelems = gfc_evaluate_now (tem, &block);
     580                 :        1092 :       tree index = gfc_create_var (gfc_array_index_type, "S");
     581                 :             : 
     582                 :        1092 :       gfc_init_block (&tmpblock);
     583                 :        1092 :       tem = gfc_conv_array_data (decl);
     584                 :        1092 :       tree declvar = build_fold_indirect_ref_loc (input_location, tem);
     585                 :        1092 :       tree declvref = gfc_build_array_ref (declvar, index, NULL);
     586                 :        1092 :       tree destvar, destvref = NULL_TREE;
     587                 :        1092 :       if (dest)
     588                 :             :         {
     589                 :         546 :           tem = gfc_conv_array_data (dest);
     590                 :         546 :           destvar = build_fold_indirect_ref_loc (input_location, tem);
     591                 :         546 :           destvref = gfc_build_array_ref (destvar, index, NULL);
     592                 :             :         }
     593                 :        1092 :       gfc_add_expr_to_block (&tmpblock,
     594                 :             :                              gfc_walk_alloc_comps (declvref, destvref,
     595                 :             :                                                    var, kind));
     596                 :             : 
     597                 :        1092 :       gfc_loopinfo loop;
     598                 :        1092 :       gfc_init_loopinfo (&loop);
     599                 :        1092 :       loop.dimen = 1;
     600                 :        1092 :       loop.from[0] = gfc_index_zero_node;
     601                 :        1092 :       loop.loopvar[0] = index;
     602                 :        1092 :       loop.to[0] = nelems;
     603                 :        1092 :       gfc_trans_scalarizing_loops (&loop, &tmpblock);
     604                 :        1092 :       gfc_add_block_to_block (&block, &loop.pre);
     605                 :        1092 :       return gfc_finish_block (&block);
     606                 :             :     }
     607                 :        1709 :   else if (GFC_DECL_GET_SCALAR_ALLOCATABLE (var))
     608                 :             :     {
     609                 :         536 :       decl = build_fold_indirect_ref_loc (input_location, decl);
     610                 :         536 :       if (dest)
     611                 :         268 :         dest = build_fold_indirect_ref_loc (input_location, dest);
     612                 :         536 :       type = TREE_TYPE (decl);
     613                 :             :     }
     614                 :             : 
     615                 :        1709 :   gcc_assert (TREE_CODE (type) == RECORD_TYPE);
     616                 :       11488 :   for (field = TYPE_FIELDS (type); field; field = DECL_CHAIN (field))
     617                 :             :     {
     618                 :        9779 :       tree ftype = TREE_TYPE (field);
     619                 :        9779 :       tree declf, destf = NULL_TREE;
     620                 :        9779 :       bool has_alloc_comps = gfc_has_alloc_comps (ftype, field);
     621                 :        9779 :       if ((!GFC_DESCRIPTOR_TYPE_P (ftype)
     622                 :        1708 :            || GFC_TYPE_ARRAY_AKIND (ftype) != GFC_ARRAY_ALLOCATABLE)
     623                 :        8071 :           && !GFC_DECL_GET_SCALAR_ALLOCATABLE (field)
     624                 :       16153 :           && !has_alloc_comps)
     625                 :        5950 :         continue;
     626                 :        3829 :       declf = fold_build3_loc (input_location, COMPONENT_REF, ftype,
     627                 :             :                                decl, field, NULL_TREE);
     628                 :        3829 :       if (dest)
     629                 :        1915 :         destf = fold_build3_loc (input_location, COMPONENT_REF, ftype,
     630                 :             :                                  dest, field, NULL_TREE);
     631                 :             : 
     632                 :        3829 :       tem = NULL_TREE;
     633                 :        3829 :       switch (kind)
     634                 :             :         {
     635                 :             :         case WALK_ALLOC_COMPS_DTOR:
     636                 :             :           break;
     637                 :         961 :         case WALK_ALLOC_COMPS_DEFAULT_CTOR:
     638                 :         961 :           if (GFC_DESCRIPTOR_TYPE_P (ftype)
     639                 :         961 :               && GFC_TYPE_ARRAY_AKIND (ftype) == GFC_ARRAY_ALLOCATABLE)
     640                 :             :             {
     641                 :         430 :               gfc_add_modify (&block, unshare_expr (destf),
     642                 :             :                               unshare_expr (declf));
     643                 :         430 :               tem = gfc_duplicate_allocatable_nocopy
     644                 :         430 :                                         (destf, declf, ftype,
     645                 :         430 :                                          GFC_TYPE_ARRAY_RANK (ftype));
     646                 :             :             }
     647                 :         531 :           else if (GFC_DECL_GET_SCALAR_ALLOCATABLE (field))
     648                 :         425 :             tem = gfc_duplicate_allocatable_nocopy (destf, declf, ftype, 0);
     649                 :             :           break;
     650                 :         954 :         case WALK_ALLOC_COMPS_COPY_CTOR:
     651                 :         954 :           if (GFC_DESCRIPTOR_TYPE_P (ftype)
     652                 :         954 :               && GFC_TYPE_ARRAY_AKIND (ftype) == GFC_ARRAY_ALLOCATABLE)
     653                 :         848 :             tem = gfc_duplicate_allocatable (destf, declf, ftype,
     654                 :         424 :                                              GFC_TYPE_ARRAY_RANK (ftype),
     655                 :             :                                              NULL_TREE);
     656                 :         530 :           else if (GFC_DECL_GET_SCALAR_ALLOCATABLE (field))
     657                 :         424 :             tem = gfc_duplicate_allocatable (destf, declf, ftype, 0,
     658                 :             :                                              NULL_TREE);
     659                 :             :           break;
     660                 :             :         }
     661                 :        1703 :       if (tem)
     662                 :        1703 :         gfc_add_expr_to_block (&block, gfc_omp_unshare_expr (tem));
     663                 :        3829 :       if (has_alloc_comps)
     664                 :             :         {
     665                 :        1272 :           gfc_init_block (&tmpblock);
     666                 :        1272 :           gfc_add_expr_to_block (&tmpblock,
     667                 :             :                                  gfc_walk_alloc_comps (declf, destf,
     668                 :             :                                                        field, kind));
     669                 :        1272 :           then_b = gfc_finish_block (&tmpblock);
     670                 :        1272 :           if (GFC_DESCRIPTOR_TYPE_P (ftype)
     671                 :        1272 :               && GFC_TYPE_ARRAY_AKIND (ftype) == GFC_ARRAY_ALLOCATABLE)
     672                 :         424 :             tem = gfc_conv_descriptor_data_get (unshare_expr (declf));
     673                 :         848 :           else if (GFC_DECL_GET_SCALAR_ALLOCATABLE (field))
     674                 :         424 :             tem = unshare_expr (declf);
     675                 :             :           else
     676                 :             :             tem = NULL_TREE;
     677                 :         848 :           if (tem)
     678                 :             :             {
     679                 :         848 :               tem = fold_convert (pvoid_type_node, tem);
     680                 :         848 :               tem = fold_build2_loc (input_location, NE_EXPR,
     681                 :             :                                      logical_type_node, tem,
     682                 :             :                                      null_pointer_node);
     683                 :         848 :               then_b = build3_loc (input_location, COND_EXPR, void_type_node,
     684                 :             :                                    tem, then_b,
     685                 :             :                                    build_empty_stmt (input_location));
     686                 :             :             }
     687                 :        1272 :           gfc_add_expr_to_block (&block, then_b);
     688                 :             :         }
     689                 :        3829 :       if (kind == WALK_ALLOC_COMPS_DTOR)
     690                 :             :         {
     691                 :        1914 :           if (GFC_DESCRIPTOR_TYPE_P (ftype)
     692                 :        1914 :               && GFC_TYPE_ARRAY_AKIND (ftype) == GFC_ARRAY_ALLOCATABLE)
     693                 :             :             {
     694                 :         854 :               tem = gfc_conv_descriptor_data_get (unshare_expr (declf));
     695                 :         854 :               tem = gfc_deallocate_with_status (tem, NULL_TREE, NULL_TREE,
     696                 :             :                                                 NULL_TREE, NULL_TREE, true,
     697                 :             :                                                 NULL,
     698                 :             :                                                 GFC_CAF_COARRAY_NOCOARRAY);
     699                 :         854 :               gfc_add_expr_to_block (&block, gfc_omp_unshare_expr (tem));
     700                 :             :             }
     701                 :        1060 :           else if (GFC_DECL_GET_SCALAR_ALLOCATABLE (field))
     702                 :             :             {
     703                 :         848 :               tem = gfc_call_free (unshare_expr (declf));
     704                 :         848 :               gfc_add_expr_to_block (&block, gfc_omp_unshare_expr (tem));
     705                 :             :             }
     706                 :             :         }
     707                 :             :     }
     708                 :             : 
     709                 :        1709 :   return gfc_finish_block (&block);
     710                 :             : }
     711                 :             : 
     712                 :             : /* Return code to initialize DECL with its default constructor, or
     713                 :             :    NULL if there's nothing to do.  */
     714                 :             : 
     715                 :             : tree
     716                 :       19195 : gfc_omp_clause_default_ctor (tree clause, tree decl, tree outer)
     717                 :             : {
     718                 :       19195 :   tree type = TREE_TYPE (decl), size, ptr, cond, then_b, else_b;
     719                 :       19195 :   stmtblock_t block, cond_block;
     720                 :             : 
     721                 :       19195 :   switch (OMP_CLAUSE_CODE (clause))
     722                 :             :     {
     723                 :             :     case OMP_CLAUSE__LOOPTEMP_:
     724                 :             :     case OMP_CLAUSE__REDUCTEMP_:
     725                 :             :     case OMP_CLAUSE__CONDTEMP_:
     726                 :             :     case OMP_CLAUSE__SCANTEMP_:
     727                 :             :       return NULL;
     728                 :       19168 :     case OMP_CLAUSE_PRIVATE:
     729                 :       19168 :     case OMP_CLAUSE_LASTPRIVATE:
     730                 :       19168 :     case OMP_CLAUSE_LINEAR:
     731                 :       19168 :     case OMP_CLAUSE_REDUCTION:
     732                 :       19168 :     case OMP_CLAUSE_IN_REDUCTION:
     733                 :       19168 :     case OMP_CLAUSE_TASK_REDUCTION:
     734                 :       19168 :       break;
     735                 :           0 :     default:
     736                 :           0 :       gcc_unreachable ();
     737                 :             :     }
     738                 :             : 
     739                 :       19168 :   if ((! GFC_DESCRIPTOR_TYPE_P (type)
     740                 :         263 :        || GFC_TYPE_ARRAY_AKIND (type) != GFC_ARRAY_ALLOCATABLE)
     741                 :       19187 :       && (!GFC_DECL_GET_SCALAR_ALLOCATABLE (OMP_CLAUSE_DECL (clause))
     742                 :          85 :           || !POINTER_TYPE_P (type)))
     743                 :             :     {
     744                 :       18839 :       if (gfc_has_alloc_comps (type, OMP_CLAUSE_DECL (clause)))
     745                 :             :         {
     746                 :          51 :           gcc_assert (outer);
     747                 :          51 :           gfc_start_block (&block);
     748                 :         102 :           tree tem = gfc_walk_alloc_comps (outer, decl,
     749                 :          51 :                                            OMP_CLAUSE_DECL (clause),
     750                 :             :                                            WALK_ALLOC_COMPS_DEFAULT_CTOR);
     751                 :          51 :           gfc_add_expr_to_block (&block, tem);
     752                 :          51 :           return gfc_finish_block (&block);
     753                 :             :         }
     754                 :             :       return NULL_TREE;
     755                 :             :     }
     756                 :             : 
     757                 :         329 :   gcc_assert (outer != NULL_TREE);
     758                 :             : 
     759                 :             :   /* Allocatable arrays and scalars in PRIVATE clauses need to be set to
     760                 :             :      "not currently allocated" allocation status if outer
     761                 :             :      array is "not currently allocated", otherwise should be allocated.  */
     762                 :         329 :   gfc_start_block (&block);
     763                 :             : 
     764                 :         329 :   gfc_init_block (&cond_block);
     765                 :             : 
     766                 :         329 :   if (GFC_DESCRIPTOR_TYPE_P (type))
     767                 :             :     {
     768                 :         244 :       gfc_add_modify (&cond_block, decl, outer);
     769                 :         244 :       tree rank = gfc_rank_cst[GFC_TYPE_ARRAY_RANK (type) - 1];
     770                 :         244 :       size = gfc_conv_descriptor_ubound_get (decl, rank);
     771                 :         244 :       size = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
     772                 :             :                               size,
     773                 :             :                               gfc_conv_descriptor_lbound_get (decl, rank));
     774                 :         244 :       size = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
     775                 :             :                               size, gfc_index_one_node);
     776                 :         244 :       if (GFC_TYPE_ARRAY_RANK (type) > 1)
     777                 :         130 :         size = fold_build2_loc (input_location, MULT_EXPR,
     778                 :             :                                 gfc_array_index_type, size,
     779                 :             :                                 gfc_conv_descriptor_stride_get (decl, rank));
     780                 :         244 :       tree esize = fold_convert (gfc_array_index_type,
     781                 :             :                                  TYPE_SIZE_UNIT (gfc_get_element_type (type)));
     782                 :         244 :       size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
     783                 :             :                               size, esize);
     784                 :         244 :       size = unshare_expr (size);
     785                 :         244 :       size = gfc_evaluate_now (fold_convert (size_type_node, size),
     786                 :             :                                &cond_block);
     787                 :             :     }
     788                 :             :   else
     789                 :          85 :     size = fold_convert (size_type_node, TYPE_SIZE_UNIT (TREE_TYPE (type)));
     790                 :         329 :   ptr = gfc_create_var (pvoid_type_node, NULL);
     791                 :         329 :   gfc_allocate_using_malloc (&cond_block, ptr, size, NULL_TREE);
     792                 :         329 :   if (GFC_DESCRIPTOR_TYPE_P (type))
     793                 :         244 :     gfc_conv_descriptor_data_set (&cond_block, unshare_expr (decl), ptr);
     794                 :             :   else
     795                 :          85 :     gfc_add_modify (&cond_block, unshare_expr (decl),
     796                 :          85 :                     fold_convert (TREE_TYPE (decl), ptr));
     797                 :         329 :   if (gfc_has_alloc_comps (type, OMP_CLAUSE_DECL (clause)))
     798                 :             :     {
     799                 :         124 :       tree tem = gfc_walk_alloc_comps (outer, decl,
     800                 :          62 :                                        OMP_CLAUSE_DECL (clause),
     801                 :             :                                        WALK_ALLOC_COMPS_DEFAULT_CTOR);
     802                 :          62 :       gfc_add_expr_to_block (&cond_block, tem);
     803                 :             :     }
     804                 :         329 :   then_b = gfc_finish_block (&cond_block);
     805                 :             : 
     806                 :             :   /* Reduction clause requires allocated ALLOCATABLE.  */
     807                 :         329 :   if (OMP_CLAUSE_CODE (clause) != OMP_CLAUSE_REDUCTION
     808                 :         185 :       && OMP_CLAUSE_CODE (clause) != OMP_CLAUSE_IN_REDUCTION
     809                 :         514 :       && OMP_CLAUSE_CODE (clause) != OMP_CLAUSE_TASK_REDUCTION)
     810                 :             :     {
     811                 :         185 :       gfc_init_block (&cond_block);
     812                 :         185 :       if (GFC_DESCRIPTOR_TYPE_P (type))
     813                 :         124 :         gfc_conv_descriptor_data_set (&cond_block, unshare_expr (decl),
     814                 :             :                                       null_pointer_node);
     815                 :             :       else
     816                 :          61 :         gfc_add_modify (&cond_block, unshare_expr (decl),
     817                 :          61 :                         build_zero_cst (TREE_TYPE (decl)));
     818                 :         185 :       else_b = gfc_finish_block (&cond_block);
     819                 :             : 
     820                 :         185 :       tree tem = fold_convert (pvoid_type_node,
     821                 :             :                                GFC_DESCRIPTOR_TYPE_P (type)
     822                 :             :                                ? gfc_conv_descriptor_data_get (outer) : outer);
     823                 :         185 :       tem = unshare_expr (tem);
     824                 :         185 :       cond = fold_build2_loc (input_location, NE_EXPR, logical_type_node,
     825                 :             :                               tem, null_pointer_node);
     826                 :         185 :       gfc_add_expr_to_block (&block,
     827                 :             :                              build3_loc (input_location, COND_EXPR,
     828                 :             :                                          void_type_node, cond, then_b,
     829                 :             :                                          else_b));
     830                 :             :       /* Avoid -W*uninitialized warnings.  */
     831                 :         185 :       if (DECL_P (decl))
     832                 :         146 :         suppress_warning (decl, OPT_Wuninitialized);
     833                 :             :     }
     834                 :             :   else
     835                 :         144 :     gfc_add_expr_to_block (&block, then_b);
     836                 :             : 
     837                 :         329 :   return gfc_finish_block (&block);
     838                 :             : }
     839                 :             : 
     840                 :             : /* Build and return code for a copy constructor from SRC to DEST.  */
     841                 :             : 
     842                 :             : tree
     843                 :        8862 : gfc_omp_clause_copy_ctor (tree clause, tree dest, tree src)
     844                 :             : {
     845                 :        8862 :   tree type = TREE_TYPE (dest), ptr, size, call;
     846                 :        8862 :   tree decl_type = TREE_TYPE (OMP_CLAUSE_DECL (clause));
     847                 :        8862 :   tree cond, then_b, else_b;
     848                 :        8862 :   stmtblock_t block, cond_block;
     849                 :             : 
     850                 :        8862 :   gcc_assert (OMP_CLAUSE_CODE (clause) == OMP_CLAUSE_FIRSTPRIVATE
     851                 :             :               || OMP_CLAUSE_CODE (clause) == OMP_CLAUSE_LINEAR);
     852                 :             : 
     853                 :             :   /* Privatize pointer, only; cf. gfc_omp_predetermined_sharing. */
     854                 :        8862 :   if (DECL_P (OMP_CLAUSE_DECL (clause))
     855                 :        8862 :       && GFC_DECL_ASSOCIATE_VAR_P (OMP_CLAUSE_DECL (clause)))
     856                 :          27 :     return build2 (MODIFY_EXPR, TREE_TYPE (dest), dest, src);
     857                 :             : 
     858                 :        8835 :   if (DECL_ARTIFICIAL (OMP_CLAUSE_DECL (clause))
     859                 :        5777 :       && DECL_LANG_SPECIFIC (OMP_CLAUSE_DECL (clause))
     860                 :        9016 :       && GFC_DECL_SAVED_DESCRIPTOR (OMP_CLAUSE_DECL (clause)))
     861                 :         167 :     decl_type
     862                 :         167 :       = TREE_TYPE (GFC_DECL_SAVED_DESCRIPTOR (OMP_CLAUSE_DECL (clause)));
     863                 :             : 
     864                 :        8835 :   if (gfc_is_polymorphic_nonptr (decl_type))
     865                 :             :     {
     866                 :          40 :       if (POINTER_TYPE_P (decl_type))
     867                 :          27 :         decl_type = TREE_TYPE (decl_type);
     868                 :          40 :       decl_type = TREE_TYPE (TYPE_FIELDS (decl_type));
     869                 :          40 :       if (GFC_DESCRIPTOR_TYPE_P (decl_type) || GFC_ARRAY_TYPE_P (decl_type))
     870                 :           4 :         fatal_error (input_location,
     871                 :             :                      "Sorry, polymorphic arrays not yet supported for "
     872                 :             :                      "firstprivate");
     873                 :          36 :       tree src_len;
     874                 :          36 :       tree nelems = build_int_cst (size_type_node, 1);  /* Scalar.  */
     875                 :          36 :       tree src_data = gfc_class_data_get (unshare_expr (src));
     876                 :          36 :       tree dest_data = gfc_class_data_get (unshare_expr (dest));
     877                 :          36 :       bool unlimited = gfc_is_unlimited_polymorphic_nonptr (type);
     878                 :             : 
     879                 :          36 :       gfc_start_block (&block);
     880                 :          36 :       gfc_add_modify (&block, gfc_class_vptr_get (dest),
     881                 :             :                       gfc_class_vptr_get (src));
     882                 :          36 :       gfc_init_block (&cond_block);
     883                 :             : 
     884                 :          36 :       if (unlimited)
     885                 :             :         {
     886                 :          24 :           src_len = gfc_class_len_get (src);
     887                 :          24 :           gfc_add_modify (&cond_block, gfc_class_len_get (unshare_expr (dest)), src_len);
     888                 :             :         }
     889                 :             : 
     890                 :             :       /* Use: size = class._vtab._size * (class._len > 0 ? class._len : 1).  */
     891                 :          36 :       size = fold_convert (size_type_node, gfc_class_vtab_size_get (src));
     892                 :          36 :       if (unlimited)
     893                 :             :         {
     894                 :          24 :           cond = fold_build2_loc (input_location, GT_EXPR, boolean_type_node,
     895                 :             :                                   unshare_expr (src_len),
     896                 :          24 :                                   build_zero_cst (TREE_TYPE (src_len)));
     897                 :          24 :           cond = build3_loc (input_location, COND_EXPR, size_type_node, cond,
     898                 :             :                              fold_convert (size_type_node,
     899                 :             :                                            unshare_expr (src_len)),
     900                 :          24 :                              build_int_cst (size_type_node, 1));
     901                 :          24 :           size = fold_build2_loc (input_location, MULT_EXPR, size_type_node,
     902                 :             :                                   size, cond);
     903                 :             :         }
     904                 :             : 
     905                 :             :       /* Malloc memory + call class->_vpt->_copy.  */
     906                 :          36 :       call = builtin_decl_explicit (BUILT_IN_MALLOC);
     907                 :          36 :       call = build_call_expr_loc (input_location, call, 1, size);
     908                 :          36 :       gfc_add_modify (&cond_block, dest_data,
     909                 :          36 :                       fold_convert (TREE_TYPE (dest_data), call));
     910                 :          36 :       gfc_add_expr_to_block (&cond_block,
     911                 :             :                              gfc_copy_class_to_class (src, dest, nelems,
     912                 :             :                                                       unlimited));
     913                 :             : 
     914                 :          36 :       gcc_assert (TREE_CODE (dest_data) == COMPONENT_REF);
     915                 :          36 :       if (!GFC_DECL_GET_SCALAR_ALLOCATABLE (TREE_OPERAND (dest_data, 1)))
     916                 :             :         {
     917                 :          12 :           gfc_add_block_to_block (&block, &cond_block);
     918                 :             :         }
     919                 :             :       else
     920                 :             :         {
     921                 :             :           /* Create: if (class._data != 0) <cond_block> else class._data = NULL; */
     922                 :          24 :           cond = fold_build2_loc (input_location, NE_EXPR, boolean_type_node,
     923                 :             :                                   src_data, null_pointer_node);
     924                 :          24 :           gfc_add_expr_to_block (&block, build3_loc (input_location, COND_EXPR,
     925                 :             :                                  void_type_node, cond,
     926                 :             :                                  gfc_finish_block (&cond_block),
     927                 :             :                                  fold_build2_loc (input_location, MODIFY_EXPR, void_type_node,
     928                 :             :                                  unshare_expr (dest_data), null_pointer_node)));
     929                 :             :         }
     930                 :          36 :       return gfc_finish_block (&block);
     931                 :             :     }
     932                 :             : 
     933                 :        8795 :   if ((! GFC_DESCRIPTOR_TYPE_P (type)
     934                 :         138 :        || GFC_TYPE_ARRAY_AKIND (type) != GFC_ARRAY_ALLOCATABLE)
     935                 :        8819 :       && (!GFC_DECL_GET_SCALAR_ALLOCATABLE (OMP_CLAUSE_DECL (clause))
     936                 :          77 :           || !POINTER_TYPE_P (type)))
     937                 :             :     {
     938                 :        8606 :       if (gfc_has_alloc_comps (type, OMP_CLAUSE_DECL (clause)))
     939                 :             :         {
     940                 :          20 :           gfc_start_block (&block);
     941                 :          20 :           gfc_add_modify (&block, dest, src);
     942                 :          20 :           tree tem = gfc_walk_alloc_comps (src, dest, OMP_CLAUSE_DECL (clause),
     943                 :             :                                            WALK_ALLOC_COMPS_COPY_CTOR);
     944                 :          20 :           gfc_add_expr_to_block (&block, tem);
     945                 :          20 :           return gfc_finish_block (&block);
     946                 :             :         }
     947                 :             :       else
     948                 :        8586 :         return build2_v (MODIFY_EXPR, dest, src);
     949                 :             :     }
     950                 :             : 
     951                 :             :   /* Allocatable arrays in FIRSTPRIVATE clauses need to be allocated
     952                 :             :      and copied from SRC.  */
     953                 :         189 :   gfc_start_block (&block);
     954                 :             : 
     955                 :         189 :   gfc_init_block (&cond_block);
     956                 :             : 
     957                 :         189 :   gfc_add_modify (&cond_block, dest, fold_convert (TREE_TYPE (dest), src));
     958                 :         189 :   if (GFC_DESCRIPTOR_TYPE_P (type))
     959                 :             :     {
     960                 :         114 :       tree rank = gfc_rank_cst[GFC_TYPE_ARRAY_RANK (type) - 1];
     961                 :         114 :       size = gfc_conv_descriptor_ubound_get (dest, rank);
     962                 :         114 :       size = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
     963                 :             :                               size,
     964                 :             :                               gfc_conv_descriptor_lbound_get (dest, rank));
     965                 :         114 :       size = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
     966                 :             :                               size, gfc_index_one_node);
     967                 :         114 :       if (GFC_TYPE_ARRAY_RANK (type) > 1)
     968                 :          42 :         size = fold_build2_loc (input_location, MULT_EXPR,
     969                 :             :                                 gfc_array_index_type, size,
     970                 :             :                                 gfc_conv_descriptor_stride_get (dest, rank));
     971                 :         114 :       tree esize = fold_convert (gfc_array_index_type,
     972                 :             :                                  TYPE_SIZE_UNIT (gfc_get_element_type (type)));
     973                 :         114 :       size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
     974                 :             :                               size, esize);
     975                 :         114 :       size = unshare_expr (size);
     976                 :         114 :       size = gfc_evaluate_now (fold_convert (size_type_node, size),
     977                 :             :                                &cond_block);
     978                 :             :     }
     979                 :             :   else
     980                 :          75 :     size = fold_convert (size_type_node, TYPE_SIZE_UNIT (TREE_TYPE (type)));
     981                 :         189 :   ptr = gfc_create_var (pvoid_type_node, NULL);
     982                 :         189 :   gfc_allocate_using_malloc (&cond_block, ptr, size, NULL_TREE);
     983                 :         189 :   if (GFC_DESCRIPTOR_TYPE_P (type))
     984                 :         114 :     gfc_conv_descriptor_data_set (&cond_block, unshare_expr (dest), ptr);
     985                 :             :   else
     986                 :          75 :     gfc_add_modify (&cond_block, unshare_expr (dest),
     987                 :          75 :                     fold_convert (TREE_TYPE (dest), ptr));
     988                 :             : 
     989                 :         189 :   tree srcptr = GFC_DESCRIPTOR_TYPE_P (type)
     990                 :         189 :                 ? gfc_conv_descriptor_data_get (src) : src;
     991                 :         189 :   srcptr = unshare_expr (srcptr);
     992                 :         189 :   srcptr = fold_convert (pvoid_type_node, srcptr);
     993                 :         189 :   call = build_call_expr_loc (input_location,
     994                 :             :                               builtin_decl_explicit (BUILT_IN_MEMCPY), 3, ptr,
     995                 :             :                               srcptr, size);
     996                 :         189 :   gfc_add_expr_to_block (&cond_block, fold_convert (void_type_node, call));
     997                 :         189 :   if (gfc_has_alloc_comps (type, OMP_CLAUSE_DECL (clause)))
     998                 :             :     {
     999                 :          48 :       tree tem = gfc_walk_alloc_comps (src, dest,
    1000                 :          24 :                                        OMP_CLAUSE_DECL (clause),
    1001                 :             :                                        WALK_ALLOC_COMPS_COPY_CTOR);
    1002                 :          24 :       gfc_add_expr_to_block (&cond_block, tem);
    1003                 :             :     }
    1004                 :         189 :   then_b = gfc_finish_block (&cond_block);
    1005                 :             : 
    1006                 :         189 :   gfc_init_block (&cond_block);
    1007                 :         189 :   if (GFC_DESCRIPTOR_TYPE_P (type))
    1008                 :         114 :     gfc_conv_descriptor_data_set (&cond_block, unshare_expr (dest),
    1009                 :             :                                   null_pointer_node);
    1010                 :             :   else
    1011                 :          75 :     gfc_add_modify (&cond_block, unshare_expr (dest),
    1012                 :          75 :                     build_zero_cst (TREE_TYPE (dest)));
    1013                 :         189 :   else_b = gfc_finish_block (&cond_block);
    1014                 :             : 
    1015                 :         189 :   cond = fold_build2_loc (input_location, NE_EXPR, logical_type_node,
    1016                 :             :                           unshare_expr (srcptr), null_pointer_node);
    1017                 :         189 :   gfc_add_expr_to_block (&block,
    1018                 :             :                          build3_loc (input_location, COND_EXPR,
    1019                 :             :                                      void_type_node, cond, then_b, else_b));
    1020                 :             :   /* Avoid -W*uninitialized warnings.  */
    1021                 :         189 :   if (DECL_P (dest))
    1022                 :         121 :     suppress_warning (dest, OPT_Wuninitialized);
    1023                 :             : 
    1024                 :         189 :   return gfc_finish_block (&block);
    1025                 :             : }
    1026                 :             : 
    1027                 :             : /* Similarly, except use an intrinsic or pointer assignment operator
    1028                 :             :    instead.  */
    1029                 :             : 
    1030                 :             : tree
    1031                 :        6258 : gfc_omp_clause_assign_op (tree clause, tree dest, tree src)
    1032                 :             : {
    1033                 :        6258 :   tree type = TREE_TYPE (dest), ptr, size, call, nonalloc;
    1034                 :        6258 :   tree cond, then_b, else_b;
    1035                 :        6258 :   stmtblock_t block, cond_block, cond_block2, inner_block;
    1036                 :             : 
    1037                 :        6258 :   if ((! GFC_DESCRIPTOR_TYPE_P (type)
    1038                 :         234 :        || GFC_TYPE_ARRAY_AKIND (type) != GFC_ARRAY_ALLOCATABLE)
    1039                 :       12313 :       && (!GFC_DECL_GET_SCALAR_ALLOCATABLE (OMP_CLAUSE_DECL (clause))
    1040                 :         136 :           || !POINTER_TYPE_P (type)))
    1041                 :             :     {
    1042                 :        5919 :       if (gfc_has_alloc_comps (type, OMP_CLAUSE_DECL (clause)))
    1043                 :             :         {
    1044                 :          30 :           gfc_start_block (&block);
    1045                 :             :           /* First dealloc any allocatable components in DEST.  */
    1046                 :          60 :           tree tem = gfc_walk_alloc_comps (dest, NULL_TREE,
    1047                 :          30 :                                            OMP_CLAUSE_DECL (clause),
    1048                 :             :                                            WALK_ALLOC_COMPS_DTOR);
    1049                 :          30 :           gfc_add_expr_to_block (&block, tem);
    1050                 :             :           /* Then copy over toplevel data.  */
    1051                 :          30 :           gfc_add_modify (&block, dest, src);
    1052                 :             :           /* Finally allocate any allocatable components and copy.  */
    1053                 :          30 :           tem = gfc_walk_alloc_comps (src, dest, OMP_CLAUSE_DECL (clause),
    1054                 :             :                                            WALK_ALLOC_COMPS_COPY_CTOR);
    1055                 :          30 :           gfc_add_expr_to_block (&block, tem);
    1056                 :          30 :           return gfc_finish_block (&block);
    1057                 :             :         }
    1058                 :             :       else
    1059                 :        5889 :         return build2_v (MODIFY_EXPR, dest, src);
    1060                 :             :     }
    1061                 :             : 
    1062                 :         339 :   gfc_start_block (&block);
    1063                 :             : 
    1064                 :         339 :   if (gfc_has_alloc_comps (type, OMP_CLAUSE_DECL (clause)))
    1065                 :             :     {
    1066                 :          32 :       then_b = gfc_walk_alloc_comps (dest, NULL_TREE, OMP_CLAUSE_DECL (clause),
    1067                 :             :                                      WALK_ALLOC_COMPS_DTOR);
    1068                 :          32 :       tree tem = fold_convert (pvoid_type_node,
    1069                 :             :                                GFC_DESCRIPTOR_TYPE_P (type)
    1070                 :             :                                ? gfc_conv_descriptor_data_get (dest) : dest);
    1071                 :          32 :       tem = unshare_expr (tem);
    1072                 :          32 :       cond = fold_build2_loc (input_location, NE_EXPR, logical_type_node,
    1073                 :             :                               tem, null_pointer_node);
    1074                 :          32 :       tem = build3_loc (input_location, COND_EXPR, void_type_node, cond,
    1075                 :             :                         then_b, build_empty_stmt (input_location));
    1076                 :          32 :       gfc_add_expr_to_block (&block, tem);
    1077                 :             :     }
    1078                 :             : 
    1079                 :         339 :   gfc_init_block (&cond_block);
    1080                 :             : 
    1081                 :         339 :   if (GFC_DESCRIPTOR_TYPE_P (type))
    1082                 :             :     {
    1083                 :         203 :       tree rank = gfc_rank_cst[GFC_TYPE_ARRAY_RANK (type) - 1];
    1084                 :         203 :       size = gfc_conv_descriptor_ubound_get (src, rank);
    1085                 :         203 :       size = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
    1086                 :             :                               size,
    1087                 :             :                               gfc_conv_descriptor_lbound_get (src, rank));
    1088                 :         203 :       size = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
    1089                 :             :                               size, gfc_index_one_node);
    1090                 :         203 :       if (GFC_TYPE_ARRAY_RANK (type) > 1)
    1091                 :          88 :         size = fold_build2_loc (input_location, MULT_EXPR,
    1092                 :             :                                 gfc_array_index_type, size,
    1093                 :             :                                 gfc_conv_descriptor_stride_get (src, rank));
    1094                 :         203 :       tree esize = fold_convert (gfc_array_index_type,
    1095                 :             :                                  TYPE_SIZE_UNIT (gfc_get_element_type (type)));
    1096                 :         203 :       size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
    1097                 :             :                               size, esize);
    1098                 :         203 :       size = unshare_expr (size);
    1099                 :         203 :       size = gfc_evaluate_now (fold_convert (size_type_node, size),
    1100                 :             :                                &cond_block);
    1101                 :             :     }
    1102                 :             :   else
    1103                 :         136 :     size = fold_convert (size_type_node, TYPE_SIZE_UNIT (TREE_TYPE (type)));
    1104                 :         339 :   ptr = gfc_create_var (pvoid_type_node, NULL);
    1105                 :             : 
    1106                 :         339 :   tree destptr = GFC_DESCRIPTOR_TYPE_P (type)
    1107                 :         339 :                  ? gfc_conv_descriptor_data_get (dest) : dest;
    1108                 :         339 :   destptr = unshare_expr (destptr);
    1109                 :         339 :   destptr = fold_convert (pvoid_type_node, destptr);
    1110                 :         339 :   gfc_add_modify (&cond_block, ptr, destptr);
    1111                 :             : 
    1112                 :         339 :   nonalloc = fold_build2_loc (input_location, EQ_EXPR, logical_type_node,
    1113                 :             :                               destptr, null_pointer_node);
    1114                 :         339 :   cond = nonalloc;
    1115                 :         339 :   if (GFC_DESCRIPTOR_TYPE_P (type))
    1116                 :             :     {
    1117                 :             :       int i;
    1118                 :         494 :       for (i = 0; i < GFC_TYPE_ARRAY_RANK (type); i++)
    1119                 :             :         {
    1120                 :         291 :           tree rank = gfc_rank_cst[i];
    1121                 :         291 :           tree tem = gfc_conv_descriptor_ubound_get (src, rank);
    1122                 :         291 :           tem = fold_build2_loc (input_location, MINUS_EXPR,
    1123                 :             :                                  gfc_array_index_type, tem,
    1124                 :             :                                  gfc_conv_descriptor_lbound_get (src, rank));
    1125                 :         291 :           tem = fold_build2_loc (input_location, PLUS_EXPR,
    1126                 :             :                                  gfc_array_index_type, tem,
    1127                 :             :                                  gfc_conv_descriptor_lbound_get (dest, rank));
    1128                 :         291 :           tem = fold_build2_loc (input_location, NE_EXPR, logical_type_node,
    1129                 :             :                                  tem, gfc_conv_descriptor_ubound_get (dest,
    1130                 :             :                                                                       rank));
    1131                 :         291 :           cond = fold_build2_loc (input_location, TRUTH_ORIF_EXPR,
    1132                 :             :                                   logical_type_node, cond, tem);
    1133                 :             :         }
    1134                 :             :     }
    1135                 :             : 
    1136                 :         339 :   gfc_init_block (&cond_block2);
    1137                 :             : 
    1138                 :         339 :   if (GFC_DESCRIPTOR_TYPE_P (type))
    1139                 :             :     {
    1140                 :         203 :       gfc_init_block (&inner_block);
    1141                 :         203 :       gfc_allocate_using_malloc (&inner_block, ptr, size, NULL_TREE);
    1142                 :         203 :       then_b = gfc_finish_block (&inner_block);
    1143                 :             : 
    1144                 :         203 :       gfc_init_block (&inner_block);
    1145                 :         203 :       gfc_add_modify (&inner_block, ptr,
    1146                 :             :                       gfc_call_realloc (&inner_block, ptr, size));
    1147                 :         203 :       else_b = gfc_finish_block (&inner_block);
    1148                 :             : 
    1149                 :         203 :       gfc_add_expr_to_block (&cond_block2,
    1150                 :             :                              build3_loc (input_location, COND_EXPR,
    1151                 :             :                                          void_type_node,
    1152                 :             :                                          unshare_expr (nonalloc),
    1153                 :             :                                          then_b, else_b));
    1154                 :         203 :       gfc_add_modify (&cond_block2, dest, src);
    1155                 :         203 :       gfc_conv_descriptor_data_set (&cond_block2, unshare_expr (dest), ptr);
    1156                 :             :     }
    1157                 :             :   else
    1158                 :             :     {
    1159                 :         136 :       gfc_allocate_using_malloc (&cond_block2, ptr, size, NULL_TREE);
    1160                 :         136 :       gfc_add_modify (&cond_block2, unshare_expr (dest),
    1161                 :             :                       fold_convert (type, ptr));
    1162                 :             :     }
    1163                 :         339 :   then_b = gfc_finish_block (&cond_block2);
    1164                 :         339 :   else_b = build_empty_stmt (input_location);
    1165                 :             : 
    1166                 :         339 :   gfc_add_expr_to_block (&cond_block,
    1167                 :             :                          build3_loc (input_location, COND_EXPR,
    1168                 :             :                                      void_type_node, unshare_expr (cond),
    1169                 :             :                                      then_b, else_b));
    1170                 :             : 
    1171                 :         339 :   tree srcptr = GFC_DESCRIPTOR_TYPE_P (type)
    1172                 :         339 :                 ? gfc_conv_descriptor_data_get (src) : src;
    1173                 :         339 :   srcptr = unshare_expr (srcptr);
    1174                 :         339 :   srcptr = fold_convert (pvoid_type_node, srcptr);
    1175                 :         339 :   call = build_call_expr_loc (input_location,
    1176                 :             :                               builtin_decl_explicit (BUILT_IN_MEMCPY), 3, ptr,
    1177                 :             :                               srcptr, size);
    1178                 :         339 :   gfc_add_expr_to_block (&cond_block, fold_convert (void_type_node, call));
    1179                 :         339 :   if (gfc_has_alloc_comps (type, OMP_CLAUSE_DECL (clause)))
    1180                 :             :     {
    1181                 :          64 :       tree tem = gfc_walk_alloc_comps (src, dest,
    1182                 :          32 :                                        OMP_CLAUSE_DECL (clause),
    1183                 :             :                                        WALK_ALLOC_COMPS_COPY_CTOR);
    1184                 :          32 :       gfc_add_expr_to_block (&cond_block, tem);
    1185                 :             :     }
    1186                 :         339 :   then_b = gfc_finish_block (&cond_block);
    1187                 :             : 
    1188                 :         339 :   if (OMP_CLAUSE_CODE (clause) == OMP_CLAUSE_COPYIN)
    1189                 :             :     {
    1190                 :          66 :       gfc_init_block (&cond_block);
    1191                 :          66 :       if (GFC_DESCRIPTOR_TYPE_P (type))
    1192                 :             :         {
    1193                 :          48 :           tree tmp = gfc_conv_descriptor_data_get (unshare_expr (dest));
    1194                 :          48 :           tmp = gfc_deallocate_with_status (tmp, NULL_TREE, NULL_TREE,
    1195                 :             :                                             NULL_TREE, NULL_TREE, true, NULL,
    1196                 :             :                                             GFC_CAF_COARRAY_NOCOARRAY);
    1197                 :          48 :           gfc_add_expr_to_block (&cond_block, tmp);
    1198                 :             :         }
    1199                 :             :       else
    1200                 :             :         {
    1201                 :          18 :           destptr = gfc_evaluate_now (destptr, &cond_block);
    1202                 :          18 :           gfc_add_expr_to_block (&cond_block, gfc_call_free (destptr));
    1203                 :          18 :           gfc_add_modify (&cond_block, unshare_expr (dest),
    1204                 :          18 :                           build_zero_cst (TREE_TYPE (dest)));
    1205                 :             :         }
    1206                 :          66 :       else_b = gfc_finish_block (&cond_block);
    1207                 :             : 
    1208                 :          66 :       cond = fold_build2_loc (input_location, NE_EXPR, logical_type_node,
    1209                 :             :                               unshare_expr (srcptr), null_pointer_node);
    1210                 :          66 :       gfc_add_expr_to_block (&block,
    1211                 :             :                              build3_loc (input_location, COND_EXPR,
    1212                 :             :                                          void_type_node, cond,
    1213                 :             :                                          then_b, else_b));
    1214                 :             :     }
    1215                 :             :   else
    1216                 :         273 :     gfc_add_expr_to_block (&block, then_b);
    1217                 :             : 
    1218                 :         339 :   return gfc_finish_block (&block);
    1219                 :             : }
    1220                 :             : 
    1221                 :             : static void
    1222                 :          84 : gfc_omp_linear_clause_add_loop (stmtblock_t *block, tree dest, tree src,
    1223                 :             :                                 tree add, tree nelems)
    1224                 :             : {
    1225                 :          84 :   stmtblock_t tmpblock;
    1226                 :          84 :   tree desta, srca, index = gfc_create_var (gfc_array_index_type, "S");
    1227                 :          84 :   nelems = gfc_evaluate_now (nelems, block);
    1228                 :             : 
    1229                 :          84 :   gfc_init_block (&tmpblock);
    1230                 :          84 :   if (TREE_CODE (TREE_TYPE (dest)) == ARRAY_TYPE)
    1231                 :             :     {
    1232                 :          60 :       desta = gfc_build_array_ref (dest, index, NULL);
    1233                 :          60 :       srca = gfc_build_array_ref (src, index, NULL);
    1234                 :             :     }
    1235                 :             :   else
    1236                 :             :     {
    1237                 :          24 :       gcc_assert (POINTER_TYPE_P (TREE_TYPE (dest)));
    1238                 :          24 :       tree idx = fold_build2 (MULT_EXPR, sizetype,
    1239                 :             :                               fold_convert (sizetype, index),
    1240                 :             :                               TYPE_SIZE_UNIT (TREE_TYPE (TREE_TYPE (dest))));
    1241                 :          24 :       desta = build_fold_indirect_ref (fold_build2 (POINTER_PLUS_EXPR,
    1242                 :             :                                                     TREE_TYPE (dest), dest,
    1243                 :             :                                                     idx));
    1244                 :          24 :       srca = build_fold_indirect_ref (fold_build2 (POINTER_PLUS_EXPR,
    1245                 :             :                                                    TREE_TYPE (src), src,
    1246                 :             :                                                     idx));
    1247                 :             :     }
    1248                 :          84 :   gfc_add_modify (&tmpblock, desta,
    1249                 :          84 :                   fold_build2 (PLUS_EXPR, TREE_TYPE (desta),
    1250                 :             :                                srca, add));
    1251                 :             : 
    1252                 :          84 :   gfc_loopinfo loop;
    1253                 :          84 :   gfc_init_loopinfo (&loop);
    1254                 :          84 :   loop.dimen = 1;
    1255                 :          84 :   loop.from[0] = gfc_index_zero_node;
    1256                 :          84 :   loop.loopvar[0] = index;
    1257                 :          84 :   loop.to[0] = nelems;
    1258                 :          84 :   gfc_trans_scalarizing_loops (&loop, &tmpblock);
    1259                 :          84 :   gfc_add_block_to_block (block, &loop.pre);
    1260                 :          84 : }
    1261                 :             : 
    1262                 :             : /* Build and return code for a constructor of DEST that initializes
    1263                 :             :    it to SRC plus ADD (ADD is scalar integer).  */
    1264                 :             : 
    1265                 :             : tree
    1266                 :         108 : gfc_omp_clause_linear_ctor (tree clause, tree dest, tree src, tree add)
    1267                 :             : {
    1268                 :         108 :   tree type = TREE_TYPE (dest), ptr, size, nelems = NULL_TREE;
    1269                 :         108 :   stmtblock_t block;
    1270                 :             : 
    1271                 :         108 :   gcc_assert (OMP_CLAUSE_CODE (clause) == OMP_CLAUSE_LINEAR);
    1272                 :             : 
    1273                 :         108 :   gfc_start_block (&block);
    1274                 :         108 :   add = gfc_evaluate_now (add, &block);
    1275                 :             : 
    1276                 :         108 :   if ((! GFC_DESCRIPTOR_TYPE_P (type)
    1277                 :          24 :        || GFC_TYPE_ARRAY_AKIND (type) != GFC_ARRAY_ALLOCATABLE)
    1278                 :         192 :       && (!GFC_DECL_GET_SCALAR_ALLOCATABLE (OMP_CLAUSE_DECL (clause))
    1279                 :          24 :           || !POINTER_TYPE_P (type)))
    1280                 :             :     {
    1281                 :          60 :       bool compute_nelts = false;
    1282                 :          60 :       gcc_assert (TREE_CODE (type) == ARRAY_TYPE);
    1283                 :          60 :       if (!TYPE_DOMAIN (type)
    1284                 :          60 :           || TYPE_MAX_VALUE (TYPE_DOMAIN (type)) == NULL_TREE
    1285                 :          60 :           || TYPE_MIN_VALUE (TYPE_DOMAIN (type)) == error_mark_node
    1286                 :         120 :           || TYPE_MAX_VALUE (TYPE_DOMAIN (type)) == error_mark_node)
    1287                 :             :         compute_nelts = true;
    1288                 :          60 :       else if (VAR_P (TYPE_MAX_VALUE (TYPE_DOMAIN (type))))
    1289                 :             :         {
    1290                 :          48 :           tree a = DECL_ATTRIBUTES (TYPE_MAX_VALUE (TYPE_DOMAIN (type)));
    1291                 :          48 :           if (lookup_attribute ("omp dummy var", a))
    1292                 :             :             compute_nelts = true;
    1293                 :             :         }
    1294                 :             :       if (compute_nelts)
    1295                 :             :         {
    1296                 :          48 :           nelems = fold_build2 (EXACT_DIV_EXPR, sizetype,
    1297                 :             :                                 TYPE_SIZE_UNIT (type),
    1298                 :             :                                 TYPE_SIZE_UNIT (TREE_TYPE (type)));
    1299                 :          48 :           nelems = size_binop (MINUS_EXPR, nelems, size_one_node);
    1300                 :             :         }
    1301                 :             :       else
    1302                 :          12 :         nelems = array_type_nelts (type);
    1303                 :          60 :       nelems = fold_convert (gfc_array_index_type, nelems);
    1304                 :             : 
    1305                 :          60 :       gfc_omp_linear_clause_add_loop (&block, dest, src, add, nelems);
    1306                 :          60 :       return gfc_finish_block (&block);
    1307                 :             :     }
    1308                 :             : 
    1309                 :             :   /* Allocatable arrays in LINEAR clauses need to be allocated
    1310                 :             :      and copied from SRC.  */
    1311                 :          48 :   gfc_add_modify (&block, dest, src);
    1312                 :          48 :   if (GFC_DESCRIPTOR_TYPE_P (type))
    1313                 :             :     {
    1314                 :          24 :       tree rank = gfc_rank_cst[GFC_TYPE_ARRAY_RANK (type) - 1];
    1315                 :          24 :       size = gfc_conv_descriptor_ubound_get (dest, rank);
    1316                 :          24 :       size = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
    1317                 :             :                               size,
    1318                 :             :                               gfc_conv_descriptor_lbound_get (dest, rank));
    1319                 :          24 :       size = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
    1320                 :             :                               size, gfc_index_one_node);
    1321                 :          24 :       if (GFC_TYPE_ARRAY_RANK (type) > 1)
    1322                 :           0 :         size = fold_build2_loc (input_location, MULT_EXPR,
    1323                 :             :                                 gfc_array_index_type, size,
    1324                 :             :                                 gfc_conv_descriptor_stride_get (dest, rank));
    1325                 :          24 :       tree esize = fold_convert (gfc_array_index_type,
    1326                 :             :                                  TYPE_SIZE_UNIT (gfc_get_element_type (type)));
    1327                 :          24 :       nelems = gfc_evaluate_now (unshare_expr (size), &block);
    1328                 :          24 :       size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
    1329                 :             :                               nelems, unshare_expr (esize));
    1330                 :          24 :       size = gfc_evaluate_now (fold_convert (size_type_node, size),
    1331                 :             :                                &block);
    1332                 :          24 :       nelems = fold_build2_loc (input_location, MINUS_EXPR,
    1333                 :             :                                 gfc_array_index_type, nelems,
    1334                 :             :                                 gfc_index_one_node);
    1335                 :             :     }
    1336                 :             :   else
    1337                 :          24 :     size = fold_convert (size_type_node, TYPE_SIZE_UNIT (TREE_TYPE (type)));
    1338                 :          48 :   ptr = gfc_create_var (pvoid_type_node, NULL);
    1339                 :          48 :   gfc_allocate_using_malloc (&block, ptr, size, NULL_TREE);
    1340                 :          48 :   if (GFC_DESCRIPTOR_TYPE_P (type))
    1341                 :             :     {
    1342                 :          24 :       gfc_conv_descriptor_data_set (&block, unshare_expr (dest), ptr);
    1343                 :          24 :       tree etype = gfc_get_element_type (type);
    1344                 :          24 :       ptr = fold_convert (build_pointer_type (etype), ptr);
    1345                 :          24 :       tree srcptr = gfc_conv_descriptor_data_get (unshare_expr (src));
    1346                 :          24 :       srcptr = fold_convert (build_pointer_type (etype), srcptr);
    1347                 :          24 :       gfc_omp_linear_clause_add_loop (&block, ptr, srcptr, add, nelems);
    1348                 :             :     }
    1349                 :             :   else
    1350                 :             :     {
    1351                 :          24 :       gfc_add_modify (&block, unshare_expr (dest),
    1352                 :          24 :                       fold_convert (TREE_TYPE (dest), ptr));
    1353                 :          24 :       ptr = fold_convert (TREE_TYPE (dest), ptr);
    1354                 :          24 :       tree dstm = build_fold_indirect_ref (ptr);
    1355                 :          24 :       tree srcm = build_fold_indirect_ref (unshare_expr (src));
    1356                 :          24 :       gfc_add_modify (&block, dstm,
    1357                 :          24 :                       fold_build2 (PLUS_EXPR, TREE_TYPE (add), srcm, add));
    1358                 :             :     }
    1359                 :          48 :   return gfc_finish_block (&block);
    1360                 :             : }
    1361                 :             : 
    1362                 :             : /* Build and return code destructing DECL.  Return NULL if nothing
    1363                 :             :    to be done.  */
    1364                 :             : 
    1365                 :             : tree
    1366                 :       30488 : gfc_omp_clause_dtor (tree clause, tree decl)
    1367                 :             : {
    1368                 :       30488 :   tree type = TREE_TYPE (decl), tem;
    1369                 :       30488 :   tree decl_type = TREE_TYPE (OMP_CLAUSE_DECL (clause));
    1370                 :             : 
    1371                 :             :   /* Only pointer was privatized; cf. gfc_omp_clause_copy_ctor. */
    1372                 :       30488 :   if (DECL_P (OMP_CLAUSE_DECL (clause))
    1373                 :       30488 :       && GFC_DECL_ASSOCIATE_VAR_P (OMP_CLAUSE_DECL (clause)))
    1374                 :             :     return NULL_TREE;
    1375                 :             : 
    1376                 :       30461 :   if (DECL_ARTIFICIAL (OMP_CLAUSE_DECL (clause))
    1377                 :       11404 :       && DECL_LANG_SPECIFIC (OMP_CLAUSE_DECL (clause))
    1378                 :       30814 :       && GFC_DECL_SAVED_DESCRIPTOR (OMP_CLAUSE_DECL (clause)))
    1379                 :         339 :     decl_type
    1380                 :         339 :         = TREE_TYPE (GFC_DECL_SAVED_DESCRIPTOR (OMP_CLAUSE_DECL (clause)));
    1381                 :       30461 :   if (gfc_is_polymorphic_nonptr (decl_type))
    1382                 :             :     {
    1383                 :          37 :       if (POINTER_TYPE_P (decl_type))
    1384                 :          24 :         decl_type = TREE_TYPE (decl_type);
    1385                 :          37 :       decl_type = TREE_TYPE (TYPE_FIELDS (decl_type));
    1386                 :          37 :       if (GFC_DESCRIPTOR_TYPE_P (decl_type) || GFC_ARRAY_TYPE_P (decl_type))
    1387                 :           0 :         fatal_error (input_location,
    1388                 :             :                      "Sorry, polymorphic arrays not yet supported for "
    1389                 :             :                      "firstprivate");
    1390                 :          37 :       stmtblock_t block, cond_block;
    1391                 :          37 :       gfc_start_block (&block);
    1392                 :          37 :       gfc_init_block (&cond_block);
    1393                 :          37 :       tree final = gfc_class_vtab_final_get (decl);
    1394                 :          37 :       tree size = fold_convert (size_type_node, gfc_class_vtab_size_get (decl));
    1395                 :          37 :       gfc_se se;
    1396                 :          37 :       gfc_init_se (&se, NULL);
    1397                 :          37 :       symbol_attribute attr = {};
    1398                 :          37 :       tree data = gfc_class_data_get (decl);
    1399                 :          37 :       tree desc = gfc_conv_scalar_to_descriptor (&se, data, attr);
    1400                 :             : 
    1401                 :             :       /* Call class->_vpt->_finalize + free.  */
    1402                 :          37 :       tree call = build_fold_indirect_ref (final);
    1403                 :          37 :       call = build_call_expr_loc (input_location, call, 3,
    1404                 :             :                                   gfc_build_addr_expr (NULL, desc),
    1405                 :             :                                   size, boolean_false_node);
    1406                 :          37 :       gfc_add_block_to_block (&cond_block, &se.pre);
    1407                 :          37 :       gfc_add_expr_to_block (&cond_block, fold_convert (void_type_node, call));
    1408                 :          37 :       gfc_add_block_to_block (&cond_block, &se.post);
    1409                 :             :       /* Create: if (_vtab && _final) <cond_block>  */
    1410                 :          37 :       tree cond = fold_build2_loc (input_location, NE_EXPR, boolean_type_node,
    1411                 :             :                                    gfc_class_vptr_get (decl),
    1412                 :             :                                    null_pointer_node);
    1413                 :          37 :       tree cond2 = fold_build2_loc (input_location, NE_EXPR, boolean_type_node,
    1414                 :             :                                    final, null_pointer_node);
    1415                 :          37 :       cond = fold_build2_loc (input_location, TRUTH_ANDIF_EXPR,
    1416                 :             :                               boolean_type_node, cond, cond2);
    1417                 :          37 :       gfc_add_expr_to_block (&block, build3_loc (input_location, COND_EXPR,
    1418                 :             :                                  void_type_node, cond,
    1419                 :             :                                  gfc_finish_block (&cond_block), NULL_TREE));
    1420                 :          37 :       call = builtin_decl_explicit (BUILT_IN_FREE);
    1421                 :          37 :       call = build_call_expr_loc (input_location, call, 1, data);
    1422                 :          37 :       gfc_add_expr_to_block (&block, fold_convert (void_type_node, call));
    1423                 :          37 :       return gfc_finish_block (&block);
    1424                 :             :     }
    1425                 :             : 
    1426                 :       30424 :   if ((! GFC_DESCRIPTOR_TYPE_P (type)
    1427                 :         433 :        || GFC_TYPE_ARRAY_AKIND (type) != GFC_ARRAY_ALLOCATABLE)
    1428                 :       30475 :       && (!GFC_DECL_GET_SCALAR_ALLOCATABLE (OMP_CLAUSE_DECL (clause))
    1429                 :         186 :           || !POINTER_TYPE_P (type)))
    1430                 :             :     {
    1431                 :       29858 :       if (gfc_has_alloc_comps (type, OMP_CLAUSE_DECL (clause)))
    1432                 :         140 :         return gfc_walk_alloc_comps (decl, NULL_TREE,
    1433                 :          70 :                                      OMP_CLAUSE_DECL (clause),
    1434                 :          70 :                                      WALK_ALLOC_COMPS_DTOR);
    1435                 :             :       return NULL_TREE;
    1436                 :             :     }
    1437                 :             : 
    1438                 :         566 :   if (GFC_DESCRIPTOR_TYPE_P (type))
    1439                 :             :     {
    1440                 :             :       /* Allocatable arrays in FIRSTPRIVATE/LASTPRIVATE etc. clauses need
    1441                 :             :          to be deallocated if they were allocated.  */
    1442                 :         382 :       tem = gfc_conv_descriptor_data_get (decl);
    1443                 :         382 :       tem = gfc_deallocate_with_status (tem, NULL_TREE, NULL_TREE, NULL_TREE,
    1444                 :             :                                         NULL_TREE, true, NULL,
    1445                 :             :                                         GFC_CAF_COARRAY_NOCOARRAY);
    1446                 :             :     }
    1447                 :             :   else
    1448                 :         184 :     tem = gfc_call_free (decl);
    1449                 :         566 :   tem = gfc_omp_unshare_expr (tem);
    1450                 :             : 
    1451                 :         566 :   if (gfc_has_alloc_comps (type, OMP_CLAUSE_DECL (clause)))
    1452                 :             :     {
    1453                 :          86 :       stmtblock_t block;
    1454                 :          86 :       tree then_b;
    1455                 :             : 
    1456                 :          86 :       gfc_init_block (&block);
    1457                 :         172 :       gfc_add_expr_to_block (&block,
    1458                 :             :                              gfc_walk_alloc_comps (decl, NULL_TREE,
    1459                 :          86 :                                                    OMP_CLAUSE_DECL (clause),
    1460                 :             :                                                    WALK_ALLOC_COMPS_DTOR));
    1461                 :          86 :       gfc_add_expr_to_block (&block, tem);
    1462                 :          86 :       then_b = gfc_finish_block (&block);
    1463                 :             : 
    1464                 :          86 :       tem = fold_convert (pvoid_type_node,
    1465                 :             :                           GFC_DESCRIPTOR_TYPE_P (type)
    1466                 :             :                           ? gfc_conv_descriptor_data_get (decl) : decl);
    1467                 :          86 :       tem = unshare_expr (tem);
    1468                 :          86 :       tree cond = fold_build2_loc (input_location, NE_EXPR, logical_type_node,
    1469                 :             :                                    tem, null_pointer_node);
    1470                 :          86 :       tem = build3_loc (input_location, COND_EXPR, void_type_node, cond,
    1471                 :             :                         then_b, build_empty_stmt (input_location));
    1472                 :             :     }
    1473                 :             :   return tem;
    1474                 :             : }
    1475                 :             : 
    1476                 :             : /* Build a conditional expression in BLOCK.  If COND_VAL is not
    1477                 :             :    null, then the block THEN_B is executed, otherwise ELSE_VAL
    1478                 :             :    is assigned to VAL.  */
    1479                 :             : 
    1480                 :             : static void
    1481                 :        1020 : gfc_build_cond_assign (stmtblock_t *block, tree val, tree cond_val,
    1482                 :             :                        tree then_b, tree else_val)
    1483                 :             : {
    1484                 :        1020 :   stmtblock_t cond_block;
    1485                 :        1020 :   tree else_b = NULL_TREE;
    1486                 :        1020 :   tree val_ty = TREE_TYPE (val);
    1487                 :             : 
    1488                 :        1020 :   if (else_val)
    1489                 :             :     {
    1490                 :        1020 :       gfc_init_block (&cond_block);
    1491                 :        1020 :       gfc_add_modify (&cond_block, val, fold_convert (val_ty, else_val));
    1492                 :        1020 :       else_b = gfc_finish_block (&cond_block);
    1493                 :             :     }
    1494                 :        1020 :   gfc_add_expr_to_block (block,
    1495                 :             :                          build3_loc (input_location, COND_EXPR, void_type_node,
    1496                 :             :                                      cond_val, then_b, else_b));
    1497                 :        1020 : }
    1498                 :             : 
    1499                 :             : /* Build a conditional expression in BLOCK, returning a temporary
    1500                 :             :    variable containing the result.  If COND_VAL is not null, then
    1501                 :             :    THEN_VAL will be assigned to the variable, otherwise ELSE_VAL
    1502                 :             :    is assigned.
    1503                 :             :  */
    1504                 :             : 
    1505                 :             : static tree
    1506                 :        1019 : gfc_build_cond_assign_expr (stmtblock_t *block, tree cond_val,
    1507                 :             :                             tree then_val, tree else_val)
    1508                 :             : {
    1509                 :        1019 :   tree val;
    1510                 :        1019 :   tree val_ty = TREE_TYPE (then_val);
    1511                 :        1019 :   stmtblock_t cond_block;
    1512                 :             : 
    1513                 :        1019 :   val = create_tmp_var (val_ty);
    1514                 :             : 
    1515                 :        1019 :   gfc_init_block (&cond_block);
    1516                 :        1019 :   gfc_add_modify (&cond_block, val, then_val);
    1517                 :        1019 :   tree then_b = gfc_finish_block (&cond_block);
    1518                 :             : 
    1519                 :        1019 :   gfc_build_cond_assign (block, val, cond_val, then_b, else_val);
    1520                 :             : 
    1521                 :        1019 :   return val;
    1522                 :             : }
    1523                 :             : 
    1524                 :             : void
    1525                 :       26051 : gfc_omp_finish_clause (tree c, gimple_seq *pre_p, bool openacc)
    1526                 :             : {
    1527                 :       26051 :   if (OMP_CLAUSE_CODE (c) != OMP_CLAUSE_MAP)
    1528                 :             :     return;
    1529                 :             : 
    1530                 :        6336 :   tree decl = OMP_CLAUSE_DECL (c);
    1531                 :             : 
    1532                 :             :   /* Assumed-size arrays can't be mapped implicitly, they have to be
    1533                 :             :      mapped explicitly using array sections.  */
    1534                 :        6336 :   if (TREE_CODE (decl) == PARM_DECL
    1535                 :        1022 :       && GFC_ARRAY_TYPE_P (TREE_TYPE (decl))
    1536                 :         356 :       && GFC_TYPE_ARRAY_AKIND (TREE_TYPE (decl)) == GFC_ARRAY_UNKNOWN
    1537                 :        6692 :       && GFC_TYPE_ARRAY_UBOUND (TREE_TYPE (decl),
    1538                 :             :                                 GFC_TYPE_ARRAY_RANK (TREE_TYPE (decl)) - 1)
    1539                 :             :          == NULL)
    1540                 :             :     {
    1541                 :           1 :       error_at (OMP_CLAUSE_LOCATION (c),
    1542                 :             :                 "implicit mapping of assumed size array %qD", decl);
    1543                 :           1 :       return;
    1544                 :             :     }
    1545                 :             : 
    1546                 :        6335 :   tree c2 = NULL_TREE, c3 = NULL_TREE, c4 = NULL_TREE;
    1547                 :        6335 :   tree present = gfc_omp_check_optional_argument (decl, true);
    1548                 :        6335 :   if (POINTER_TYPE_P (TREE_TYPE (decl)))
    1549                 :             :     {
    1550                 :        1240 :       if (!gfc_omp_privatize_by_reference (decl)
    1551                 :         136 :           && !GFC_DECL_GET_SCALAR_POINTER (decl)
    1552                 :          73 :           && !GFC_DECL_GET_SCALAR_ALLOCATABLE (decl)
    1553                 :           2 :           && !GFC_DECL_CRAY_POINTEE (decl)
    1554                 :        1242 :           && !GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (TREE_TYPE (decl))))
    1555                 :             :         return;
    1556                 :        1238 :       tree orig_decl = decl;
    1557                 :             : 
    1558                 :        1238 :       c4 = build_omp_clause (OMP_CLAUSE_LOCATION (c), OMP_CLAUSE_MAP);
    1559                 :        1238 :       OMP_CLAUSE_SET_MAP_KIND (c4, GOMP_MAP_POINTER);
    1560                 :        1238 :       OMP_CLAUSE_DECL (c4) = decl;
    1561                 :        1238 :       OMP_CLAUSE_SIZE (c4) = size_int (0);
    1562                 :        1238 :       decl = build_fold_indirect_ref (decl);
    1563                 :        1238 :       if (present
    1564                 :        1238 :           && (GFC_DECL_GET_SCALAR_POINTER (orig_decl)
    1565                 :         265 :               || GFC_DECL_GET_SCALAR_ALLOCATABLE (orig_decl)))
    1566                 :             :         {
    1567                 :          66 :           c2 = build_omp_clause (input_location, OMP_CLAUSE_MAP);
    1568                 :          66 :           OMP_CLAUSE_SET_MAP_KIND (c2, GOMP_MAP_POINTER);
    1569                 :          66 :           OMP_CLAUSE_DECL (c2) = decl;
    1570                 :          66 :           OMP_CLAUSE_SIZE (c2) = size_int (0);
    1571                 :             : 
    1572                 :          66 :           stmtblock_t block;
    1573                 :          66 :           gfc_start_block (&block);
    1574                 :          66 :           tree ptr = decl;
    1575                 :          66 :           ptr = gfc_build_cond_assign_expr (&block, present, decl,
    1576                 :             :                                             null_pointer_node);
    1577                 :          66 :           gimplify_and_add (gfc_finish_block (&block), pre_p);
    1578                 :          66 :           ptr = build_fold_indirect_ref (ptr);
    1579                 :          66 :           OMP_CLAUSE_DECL (c) = ptr;
    1580                 :          66 :           OMP_CLAUSE_SIZE (c) = TYPE_SIZE_UNIT (TREE_TYPE (ptr));
    1581                 :             :         }
    1582                 :             :       else
    1583                 :             :         {
    1584                 :        1172 :           OMP_CLAUSE_DECL (c) = decl;
    1585                 :        1172 :           OMP_CLAUSE_SIZE (c) = NULL_TREE;
    1586                 :             :         }
    1587                 :        1238 :       if (TREE_CODE (TREE_TYPE (orig_decl)) == REFERENCE_TYPE
    1588                 :        1238 :           && (GFC_DECL_GET_SCALAR_POINTER (orig_decl)
    1589                 :         384 :               || GFC_DECL_GET_SCALAR_ALLOCATABLE (orig_decl)))
    1590                 :             :         {
    1591                 :          66 :           c3 = build_omp_clause (OMP_CLAUSE_LOCATION (c), OMP_CLAUSE_MAP);
    1592                 :          66 :           OMP_CLAUSE_SET_MAP_KIND (c3, GOMP_MAP_POINTER);
    1593                 :          66 :           OMP_CLAUSE_DECL (c3) = unshare_expr (decl);
    1594                 :          66 :           OMP_CLAUSE_SIZE (c3) = size_int (0);
    1595                 :          66 :           decl = build_fold_indirect_ref (decl);
    1596                 :          66 :           OMP_CLAUSE_DECL (c) = decl;
    1597                 :             :         }
    1598                 :             :     }
    1599                 :        6333 :   if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (decl)))
    1600                 :             :     {
    1601                 :        1589 :       stmtblock_t block;
    1602                 :        1589 :       gfc_start_block (&block);
    1603                 :        1589 :       tree type = TREE_TYPE (decl);
    1604                 :        1589 :       tree ptr = gfc_conv_descriptor_data_get (decl);
    1605                 :             : 
    1606                 :             :       /* OpenMP: automatically map pointer targets with the pointer;
    1607                 :             :          hence, always update the descriptor/pointer itself.
    1608                 :             :          NOTE: This also remaps the pointer for allocatable arrays with
    1609                 :             :          'target' attribute which also don't have the 'restrict' qualifier.  */
    1610                 :        1589 :       bool always_modifier = false;
    1611                 :             : 
    1612                 :        1589 :       if (!openacc
    1613                 :        1589 :           && !(TYPE_QUALS (TREE_TYPE (ptr)) & TYPE_QUAL_RESTRICT))
    1614                 :             :         always_modifier = true;
    1615                 :             : 
    1616                 :        1589 :       if (present)
    1617                 :          55 :         ptr = gfc_build_cond_assign_expr (&block, present, ptr,
    1618                 :             :                                           null_pointer_node);
    1619                 :        1589 :       gcc_assert (POINTER_TYPE_P (TREE_TYPE (ptr)));
    1620                 :        1589 :       ptr = build_fold_indirect_ref (ptr);
    1621                 :        1589 :       OMP_CLAUSE_DECL (c) = ptr;
    1622                 :        1589 :       c2 = build_omp_clause (input_location, OMP_CLAUSE_MAP);
    1623                 :        1589 :       OMP_CLAUSE_SET_MAP_KIND (c2, GOMP_MAP_TO_PSET);
    1624                 :        1589 :       if (present)
    1625                 :             :         {
    1626                 :          55 :           ptr = create_tmp_var (TREE_TYPE (TREE_OPERAND (decl, 0)));
    1627                 :          55 :           gfc_add_modify (&block, ptr, TREE_OPERAND (decl, 0));
    1628                 :             : 
    1629                 :          55 :           OMP_CLAUSE_DECL (c2) = build_fold_indirect_ref (ptr);
    1630                 :             :         }
    1631                 :             :       else
    1632                 :        1534 :         OMP_CLAUSE_DECL (c2) = decl;
    1633                 :        1589 :       OMP_CLAUSE_SIZE (c2) = TYPE_SIZE_UNIT (type);
    1634                 :        1589 :       c3 = build_omp_clause (OMP_CLAUSE_LOCATION (c), OMP_CLAUSE_MAP);
    1635                 :        2967 :       OMP_CLAUSE_SET_MAP_KIND (c3, always_modifier ? GOMP_MAP_ALWAYS_POINTER
    1636                 :             :                                                    : GOMP_MAP_POINTER);
    1637                 :        1589 :       if (present)
    1638                 :             :         {
    1639                 :          55 :           ptr = gfc_conv_descriptor_data_get (decl);
    1640                 :          55 :           ptr = gfc_build_addr_expr (NULL, ptr);
    1641                 :          55 :           ptr = gfc_build_cond_assign_expr (&block, present,
    1642                 :             :                                             ptr, null_pointer_node);
    1643                 :          55 :           ptr = build_fold_indirect_ref (ptr);
    1644                 :          55 :           OMP_CLAUSE_DECL (c3) = ptr;
    1645                 :             :         }
    1646                 :             :       else
    1647                 :        1534 :         OMP_CLAUSE_DECL (c3) = gfc_conv_descriptor_data_get (decl);
    1648                 :        1589 :       OMP_CLAUSE_SIZE (c3) = size_int (0);
    1649                 :        1589 :       tree size = create_tmp_var (gfc_array_index_type);
    1650                 :        1589 :       tree elemsz = TYPE_SIZE_UNIT (gfc_get_element_type (type));
    1651                 :        1589 :       elemsz = fold_convert (gfc_array_index_type, elemsz);
    1652                 :        1589 :       if (GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_ALLOCATABLE
    1653                 :         212 :           || GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_POINTER
    1654                 :        1590 :           || GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_POINTER_CONT)
    1655                 :             :         {
    1656                 :        1588 :           stmtblock_t cond_block;
    1657                 :        1588 :           tree tem, then_b, else_b, zero, cond;
    1658                 :             : 
    1659                 :        1588 :           gfc_init_block (&cond_block);
    1660                 :        4764 :           tem = gfc_full_array_size (&cond_block, decl,
    1661                 :        1588 :                                      GFC_TYPE_ARRAY_RANK (type));
    1662                 :        1588 :           gfc_add_modify (&cond_block, size, tem);
    1663                 :        1588 :           gfc_add_modify (&cond_block, size,
    1664                 :             :                           fold_build2 (MULT_EXPR, gfc_array_index_type,
    1665                 :             :                                        size, elemsz));
    1666                 :        1588 :           then_b = gfc_finish_block (&cond_block);
    1667                 :        1588 :           gfc_init_block (&cond_block);
    1668                 :        1588 :           zero = build_int_cst (gfc_array_index_type, 0);
    1669                 :        1588 :           gfc_add_modify (&cond_block, size, zero);
    1670                 :        1588 :           else_b = gfc_finish_block (&cond_block);
    1671                 :        1588 :           tem = gfc_conv_descriptor_data_get (decl);
    1672                 :        1588 :           tem = fold_convert (pvoid_type_node, tem);
    1673                 :        1588 :           cond = fold_build2_loc (input_location, NE_EXPR,
    1674                 :             :                                   boolean_type_node, tem, null_pointer_node);
    1675                 :        1588 :           if (present)
    1676                 :             :             {
    1677                 :          54 :               cond = fold_build2_loc (input_location, TRUTH_ANDIF_EXPR,
    1678                 :             :                                       boolean_type_node, present, cond);
    1679                 :             :             }
    1680                 :        1588 :           gfc_add_expr_to_block (&block, build3_loc (input_location, COND_EXPR,
    1681                 :             :                                                      void_type_node, cond,
    1682                 :             :                                                      then_b, else_b));
    1683                 :             :         }
    1684                 :           1 :       else if (present)
    1685                 :             :         {
    1686                 :           1 :           stmtblock_t cond_block;
    1687                 :           1 :           tree then_b;
    1688                 :             : 
    1689                 :           1 :           gfc_init_block (&cond_block);
    1690                 :           1 :           gfc_add_modify (&cond_block, size,
    1691                 :             :                           gfc_full_array_size (&cond_block, decl,
    1692                 :           1 :                                                GFC_TYPE_ARRAY_RANK (type)));
    1693                 :           1 :           gfc_add_modify (&cond_block, size,
    1694                 :             :                           fold_build2 (MULT_EXPR, gfc_array_index_type,
    1695                 :             :                                        size, elemsz));
    1696                 :           1 :           then_b = gfc_finish_block (&cond_block);
    1697                 :             : 
    1698                 :           1 :           gfc_build_cond_assign (&block, size, present, then_b,
    1699                 :           1 :                                  build_int_cst (gfc_array_index_type, 0));
    1700                 :             :         }
    1701                 :             :       else
    1702                 :             :         {
    1703                 :           0 :           gfc_add_modify (&block, size,
    1704                 :             :                           gfc_full_array_size (&block, decl,
    1705                 :           0 :                                                GFC_TYPE_ARRAY_RANK (type)));
    1706                 :           0 :           gfc_add_modify (&block, size,
    1707                 :             :                           fold_build2 (MULT_EXPR, gfc_array_index_type,
    1708                 :             :                                        size, elemsz));
    1709                 :             :         }
    1710                 :        1589 :       OMP_CLAUSE_SIZE (c) = size;
    1711                 :        1589 :       tree stmt = gfc_finish_block (&block);
    1712                 :        1589 :       gimplify_and_add (stmt, pre_p);
    1713                 :             :     }
    1714                 :        6333 :   tree last = c;
    1715                 :        6333 :   if (OMP_CLAUSE_SIZE (c) == NULL_TREE)
    1716                 :        1113 :     OMP_CLAUSE_SIZE (c)
    1717                 :        3169 :       = DECL_P (decl) ? DECL_SIZE_UNIT (decl)
    1718                 :         943 :                       : TYPE_SIZE_UNIT (TREE_TYPE (decl));
    1719                 :        6333 :   if (gimplify_expr (&OMP_CLAUSE_SIZE (c), pre_p,
    1720                 :             :                      NULL, is_gimple_val, fb_rvalue) == GS_ERROR)
    1721                 :           0 :     OMP_CLAUSE_SIZE (c) = size_int (0);
    1722                 :        6333 :   if (c2)
    1723                 :             :     {
    1724                 :        1655 :       OMP_CLAUSE_CHAIN (c2) = OMP_CLAUSE_CHAIN (last);
    1725                 :        1655 :       OMP_CLAUSE_CHAIN (last) = c2;
    1726                 :        1655 :       last = c2;
    1727                 :             :     }
    1728                 :        6333 :   if (c3)
    1729                 :             :     {
    1730                 :        1655 :       OMP_CLAUSE_CHAIN (c3) = OMP_CLAUSE_CHAIN (last);
    1731                 :        1655 :       OMP_CLAUSE_CHAIN (last) = c3;
    1732                 :        1655 :       last = c3;
    1733                 :             :     }
    1734                 :        6333 :   if (c4)
    1735                 :             :     {
    1736                 :        1238 :       OMP_CLAUSE_CHAIN (c4) = OMP_CLAUSE_CHAIN (last);
    1737                 :        1238 :       OMP_CLAUSE_CHAIN (last) = c4;
    1738                 :             :     }
    1739                 :             : }
    1740                 :             : 
    1741                 :             : 
    1742                 :             : /* Return true if DECL is a scalar variable (for the purpose of
    1743                 :             :    implicit firstprivatization/mapping). Only if 'ptr_alloc_ok.'
    1744                 :             :    is true, allocatables and pointers are permitted. */
    1745                 :             : 
    1746                 :             : bool
    1747                 :        3254 : gfc_omp_scalar_p (tree decl, bool ptr_alloc_ok)
    1748                 :             : {
    1749                 :        3254 :   tree type = TREE_TYPE (decl);
    1750                 :        3254 :   if (TREE_CODE (type) == REFERENCE_TYPE)
    1751                 :        1263 :     type = TREE_TYPE (type);
    1752                 :        3254 :   if (TREE_CODE (type) == POINTER_TYPE)
    1753                 :             :     {
    1754                 :         548 :       if (GFC_DECL_GET_SCALAR_ALLOCATABLE (decl)
    1755                 :         548 :           || GFC_DECL_GET_SCALAR_POINTER (decl))
    1756                 :             :         {
    1757                 :         148 :           if (!ptr_alloc_ok)
    1758                 :             :             return false;
    1759                 :           0 :           type = TREE_TYPE (type);
    1760                 :             :         }
    1761                 :         400 :       if (GFC_ARRAY_TYPE_P (type)
    1762                 :         400 :           || GFC_CLASS_TYPE_P (type))
    1763                 :             :         return false;
    1764                 :             :     }
    1765                 :        2736 :   if ((TREE_CODE (type) == ARRAY_TYPE || TREE_CODE (type) == INTEGER_TYPE)
    1766                 :        4933 :       && TYPE_STRING_FLAG (type))
    1767                 :             :     return false;
    1768                 :        2808 :   if (INTEGRAL_TYPE_P (type)
    1769                 :        2808 :       || SCALAR_FLOAT_TYPE_P (type)
    1770                 :        2808 :       || COMPLEX_FLOAT_TYPE_P (type))
    1771                 :             :     return true;
    1772                 :             :   return false;
    1773                 :             : }
    1774                 :             : 
    1775                 :             : 
    1776                 :             : /* Return true if DECL is a scalar with target attribute but does not have the
    1777                 :             :    allocatable (or pointer) attribute (for the purpose of implicit mapping).  */
    1778                 :             : 
    1779                 :             : bool
    1780                 :        3148 : gfc_omp_scalar_target_p (tree decl)
    1781                 :             : {
    1782                 :        3148 :   return (DECL_P (decl) && GFC_DECL_GET_SCALAR_TARGET (decl)
    1783                 :        3247 :           && gfc_omp_scalar_p (decl, false));
    1784                 :             : }
    1785                 :             : 
    1786                 :             : 
    1787                 :             : /* Return true if DECL's DECL_VALUE_EXPR (if any) should be
    1788                 :             :    disregarded in OpenMP construct, because it is going to be
    1789                 :             :    remapped during OpenMP lowering.  SHARED is true if DECL
    1790                 :             :    is going to be shared, false if it is going to be privatized.  */
    1791                 :             : 
    1792                 :             : bool
    1793                 :     1460880 : gfc_omp_disregard_value_expr (tree decl, bool shared)
    1794                 :             : {
    1795                 :     1460880 :   if (GFC_DECL_COMMON_OR_EQUIV (decl)
    1796                 :     1460880 :       && DECL_HAS_VALUE_EXPR_P (decl))
    1797                 :             :     {
    1798                 :        3039 :       tree value = DECL_VALUE_EXPR (decl);
    1799                 :             : 
    1800                 :        3039 :       if (TREE_CODE (value) == COMPONENT_REF
    1801                 :        3039 :           && VAR_P (TREE_OPERAND (value, 0))
    1802                 :        6078 :           && GFC_DECL_COMMON_OR_EQUIV (TREE_OPERAND (value, 0)))
    1803                 :             :         {
    1804                 :             :           /* If variable in COMMON or EQUIVALENCE is privatized, return
    1805                 :             :              true, as just that variable is supposed to be privatized,
    1806                 :             :              not the whole COMMON or whole EQUIVALENCE.
    1807                 :             :              For shared variables in COMMON or EQUIVALENCE, let them be
    1808                 :             :              gimplified to DECL_VALUE_EXPR, so that for multiple shared vars
    1809                 :             :              from the same COMMON or EQUIVALENCE just one sharing of the
    1810                 :             :              whole COMMON or EQUIVALENCE is enough.  */
    1811                 :        3039 :           return ! shared;
    1812                 :             :         }
    1813                 :             :     }
    1814                 :             : 
    1815                 :     1457841 :   if (GFC_DECL_RESULT (decl) && DECL_HAS_VALUE_EXPR_P (decl))
    1816                 :         374 :     return ! shared;
    1817                 :             : 
    1818                 :             :   return false;
    1819                 :             : }
    1820                 :             : 
    1821                 :             : /* Return true if DECL that is shared iff SHARED is true should
    1822                 :             :    be put into OMP_CLAUSE_PRIVATE with OMP_CLAUSE_PRIVATE_DEBUG
    1823                 :             :    flag set.  */
    1824                 :             : 
    1825                 :             : bool
    1826                 :       35491 : gfc_omp_private_debug_clause (tree decl, bool shared)
    1827                 :             : {
    1828                 :       35491 :   if (GFC_DECL_CRAY_POINTEE (decl))
    1829                 :             :     return true;
    1830                 :             : 
    1831                 :       35455 :   if (GFC_DECL_COMMON_OR_EQUIV (decl)
    1832                 :       35455 :       && DECL_HAS_VALUE_EXPR_P (decl))
    1833                 :             :     {
    1834                 :         326 :       tree value = DECL_VALUE_EXPR (decl);
    1835                 :             : 
    1836                 :         326 :       if (TREE_CODE (value) == COMPONENT_REF
    1837                 :         326 :           && VAR_P (TREE_OPERAND (value, 0))
    1838                 :         652 :           && GFC_DECL_COMMON_OR_EQUIV (TREE_OPERAND (value, 0)))
    1839                 :             :         return shared;
    1840                 :             :     }
    1841                 :             : 
    1842                 :             :   return false;
    1843                 :             : }
    1844                 :             : 
    1845                 :             : /* Register language specific type size variables as potentially OpenMP
    1846                 :             :    firstprivate variables.  */
    1847                 :             : 
    1848                 :             : void
    1849                 :       19705 : gfc_omp_firstprivatize_type_sizes (struct gimplify_omp_ctx *ctx, tree type)
    1850                 :             : {
    1851                 :       19705 :   if (GFC_ARRAY_TYPE_P (type) || GFC_DESCRIPTOR_TYPE_P (type))
    1852                 :             :     {
    1853                 :        3526 :       int r;
    1854                 :             : 
    1855                 :        3526 :       gcc_assert (TYPE_LANG_SPECIFIC (type) != NULL);
    1856                 :        8229 :       for (r = 0; r < GFC_TYPE_ARRAY_RANK (type); r++)
    1857                 :             :         {
    1858                 :        4703 :           omp_firstprivatize_variable (ctx, GFC_TYPE_ARRAY_LBOUND (type, r));
    1859                 :        4703 :           omp_firstprivatize_variable (ctx, GFC_TYPE_ARRAY_UBOUND (type, r));
    1860                 :        4703 :           omp_firstprivatize_variable (ctx, GFC_TYPE_ARRAY_STRIDE (type, r));
    1861                 :             :         }
    1862                 :        3526 :       omp_firstprivatize_variable (ctx, GFC_TYPE_ARRAY_SIZE (type));
    1863                 :        3526 :       omp_firstprivatize_variable (ctx, GFC_TYPE_ARRAY_OFFSET (type));
    1864                 :             :     }
    1865                 :       19705 : }
    1866                 :             : 
    1867                 :             : 
    1868                 :             : static inline tree
    1869                 :       66112 : gfc_trans_add_clause (tree node, tree tail)
    1870                 :             : {
    1871                 :       66112 :   OMP_CLAUSE_CHAIN (node) = tail;
    1872                 :       66112 :   return node;
    1873                 :             : }
    1874                 :             : 
    1875                 :             : static tree
    1876                 :       39156 : gfc_trans_omp_variable (gfc_symbol *sym, bool declare_simd)
    1877                 :             : {
    1878                 :       39156 :   if (declare_simd)
    1879                 :             :     {
    1880                 :         192 :       int cnt = 0;
    1881                 :         192 :       gfc_symbol *proc_sym;
    1882                 :         192 :       gfc_formal_arglist *f;
    1883                 :             : 
    1884                 :         192 :       gcc_assert (sym->attr.dummy);
    1885                 :         192 :       proc_sym = sym->ns->proc_name;
    1886                 :         192 :       if (proc_sym->attr.entry_master)
    1887                 :           0 :         ++cnt;
    1888                 :         192 :       if (gfc_return_by_reference (proc_sym))
    1889                 :             :         {
    1890                 :           0 :           ++cnt;
    1891                 :           0 :           if (proc_sym->ts.type == BT_CHARACTER)
    1892                 :           0 :             ++cnt;
    1893                 :             :         }
    1894                 :         364 :       for (f = gfc_sym_get_dummy_args (proc_sym); f; f = f->next)
    1895                 :         364 :         if (f->sym == sym)
    1896                 :             :           break;
    1897                 :         172 :         else if (f->sym)
    1898                 :         172 :           ++cnt;
    1899                 :         192 :       gcc_assert (f);
    1900                 :         192 :       return build_int_cst (integer_type_node, cnt);
    1901                 :             :     }
    1902                 :             : 
    1903                 :       38964 :   tree t = gfc_get_symbol_decl (sym);
    1904                 :       38964 :   tree parent_decl;
    1905                 :       38964 :   int parent_flag;
    1906                 :       38964 :   bool return_value;
    1907                 :       38964 :   bool alternate_entry;
    1908                 :       38964 :   bool entry_master;
    1909                 :             : 
    1910                 :       38964 :   return_value = sym->attr.function && sym->result == sym;
    1911                 :         133 :   alternate_entry = sym->attr.function && sym->attr.entry
    1912                 :       38998 :                     && sym->result == sym;
    1913                 :       77928 :   entry_master = sym->attr.result
    1914                 :         109 :                  && sym->ns->proc_name->attr.entry_master
    1915                 :       38976 :                  && !gfc_return_by_reference (sym->ns->proc_name);
    1916                 :       77928 :   parent_decl = current_function_decl
    1917                 :       38964 :                 ? DECL_CONTEXT (current_function_decl) : NULL_TREE;
    1918                 :             : 
    1919                 :       38964 :   if ((t == parent_decl && return_value)
    1920                 :       38957 :        || (sym->ns && sym->ns->proc_name
    1921                 :       38957 :            && sym->ns->proc_name->backend_decl == parent_decl
    1922                 :        2121 :            && (alternate_entry || entry_master)))
    1923                 :             :     parent_flag = 1;
    1924                 :             :   else
    1925                 :       38955 :     parent_flag = 0;
    1926                 :             : 
    1927                 :             :   /* Special case for assigning the return value of a function.
    1928                 :             :      Self recursive functions must have an explicit return value.  */
    1929                 :       38964 :   if (return_value && (t == current_function_decl || parent_flag))
    1930                 :          81 :     t = gfc_get_fake_result_decl (sym, parent_flag);
    1931                 :             : 
    1932                 :             :   /* Similarly for alternate entry points.  */
    1933                 :       38883 :   else if (alternate_entry
    1934                 :          32 :            && (sym->ns->proc_name->backend_decl == current_function_decl
    1935                 :           0 :                || parent_flag))
    1936                 :             :     {
    1937                 :          32 :       gfc_entry_list *el = NULL;
    1938                 :             : 
    1939                 :          51 :       for (el = sym->ns->entries; el; el = el->next)
    1940                 :          51 :         if (sym == el->sym)
    1941                 :             :           {
    1942                 :          32 :             t = gfc_get_fake_result_decl (sym, parent_flag);
    1943                 :          32 :             break;
    1944                 :             :           }
    1945                 :             :     }
    1946                 :             : 
    1947                 :       38851 :   else if (entry_master
    1948                 :          12 :            && (sym->ns->proc_name->backend_decl == current_function_decl
    1949                 :           0 :                || parent_flag))
    1950                 :          12 :     t = gfc_get_fake_result_decl (sym, parent_flag);
    1951                 :             : 
    1952                 :             :   return t;
    1953                 :             : }
    1954                 :             : 
    1955                 :             : static tree
    1956                 :       10740 : gfc_trans_omp_variable_list (enum omp_clause_code code,
    1957                 :             :                              gfc_omp_namelist *namelist, tree list,
    1958                 :             :                              bool declare_simd)
    1959                 :             : {
    1960                 :       27929 :   for (; namelist != NULL; namelist = namelist->next)
    1961                 :       17189 :     if (namelist->sym->attr.referenced || declare_simd)
    1962                 :             :       {
    1963                 :       17189 :         tree t = gfc_trans_omp_variable (namelist->sym, declare_simd);
    1964                 :       17189 :         if (t != error_mark_node)
    1965                 :             :           {
    1966                 :       17189 :             tree node;
    1967                 :       17189 :             node = build_omp_clause (input_location, code);
    1968                 :       17189 :             OMP_CLAUSE_DECL (node) = t;
    1969                 :       17189 :             list = gfc_trans_add_clause (node, list);
    1970                 :             : 
    1971                 :       17189 :             if (code == OMP_CLAUSE_LASTPRIVATE
    1972                 :        2822 :                 && namelist->u.lastprivate_conditional)
    1973                 :          88 :               OMP_CLAUSE_LASTPRIVATE_CONDITIONAL (node) = 1;
    1974                 :             :           }
    1975                 :             :       }
    1976                 :       10740 :   return list;
    1977                 :             : }
    1978                 :             : 
    1979                 :             : struct omp_udr_find_orig_data
    1980                 :             : {
    1981                 :             :   gfc_omp_udr *omp_udr;
    1982                 :             :   bool omp_orig_seen;
    1983                 :             : };
    1984                 :             : 
    1985                 :             : static int
    1986                 :         678 : omp_udr_find_orig (gfc_expr **e, int *walk_subtrees ATTRIBUTE_UNUSED,
    1987                 :             :                    void *data)
    1988                 :             : {
    1989                 :         678 :   struct omp_udr_find_orig_data *cd = (struct omp_udr_find_orig_data *) data;
    1990                 :         678 :   if ((*e)->expr_type == EXPR_VARIABLE
    1991                 :         366 :       && (*e)->symtree->n.sym == cd->omp_udr->omp_orig)
    1992                 :          72 :     cd->omp_orig_seen = true;
    1993                 :             : 
    1994                 :         678 :   return 0;
    1995                 :             : }
    1996                 :             : 
    1997                 :             : static void
    1998                 :         683 : gfc_trans_omp_array_reduction_or_udr (tree c, gfc_omp_namelist *n, locus where)
    1999                 :             : {
    2000                 :         683 :   gfc_symbol *sym = n->sym;
    2001                 :         683 :   gfc_symtree *root1 = NULL, *root2 = NULL, *root3 = NULL, *root4 = NULL;
    2002                 :         683 :   gfc_symtree *symtree1, *symtree2, *symtree3, *symtree4 = NULL;
    2003                 :         683 :   gfc_symbol init_val_sym, outer_sym, intrinsic_sym;
    2004                 :         683 :   gfc_symbol omp_var_copy[4];
    2005                 :         683 :   gfc_expr *e1, *e2, *e3, *e4;
    2006                 :         683 :   gfc_ref *ref;
    2007                 :         683 :   tree decl, backend_decl, stmt, type, outer_decl;
    2008                 :         683 :   locus old_loc = gfc_current_locus;
    2009                 :         683 :   const char *iname;
    2010                 :         683 :   bool t;
    2011                 :         683 :   gfc_omp_udr *udr = n->u2.udr ? n->u2.udr->udr : NULL;
    2012                 :             : 
    2013                 :         683 :   decl = OMP_CLAUSE_DECL (c);
    2014                 :         683 :   gfc_current_locus = where;
    2015                 :         683 :   type = TREE_TYPE (decl);
    2016                 :         683 :   outer_decl = create_tmp_var_raw (type);
    2017                 :         683 :   if (TREE_CODE (decl) == PARM_DECL
    2018                 :          31 :       && TREE_CODE (type) == REFERENCE_TYPE
    2019                 :          12 :       && GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (type))
    2020                 :         695 :       && GFC_TYPE_ARRAY_AKIND (TREE_TYPE (type)) == GFC_ARRAY_ALLOCATABLE)
    2021                 :             :     {
    2022                 :          12 :       decl = build_fold_indirect_ref (decl);
    2023                 :          12 :       type = TREE_TYPE (type);
    2024                 :             :     }
    2025                 :             : 
    2026                 :             :   /* Create a fake symbol for init value.  */
    2027                 :         683 :   memset (&init_val_sym, 0, sizeof (init_val_sym));
    2028                 :         683 :   init_val_sym.ns = sym->ns;
    2029                 :         683 :   init_val_sym.name = sym->name;
    2030                 :         683 :   init_val_sym.ts = sym->ts;
    2031                 :         683 :   init_val_sym.attr.referenced = 1;
    2032                 :         683 :   init_val_sym.declared_at = where;
    2033                 :         683 :   init_val_sym.attr.flavor = FL_VARIABLE;
    2034                 :         683 :   if (OMP_CLAUSE_REDUCTION_CODE (c) != ERROR_MARK)
    2035                 :         283 :     backend_decl = omp_reduction_init (c, gfc_sym_type (&init_val_sym));
    2036                 :         400 :   else if (udr->initializer_ns)
    2037                 :             :     backend_decl = NULL;
    2038                 :             :   else
    2039                 :         130 :     switch (sym->ts.type)
    2040                 :             :       {
    2041                 :          15 :       case BT_LOGICAL:
    2042                 :          15 :       case BT_INTEGER:
    2043                 :          15 :       case BT_REAL:
    2044                 :          15 :       case BT_COMPLEX:
    2045                 :          15 :         backend_decl = build_zero_cst (gfc_sym_type (&init_val_sym));
    2046                 :          15 :         break;
    2047                 :             :       default:
    2048                 :             :         backend_decl = NULL_TREE;
    2049                 :             :         break;
    2050                 :             :       }
    2051                 :         683 :   init_val_sym.backend_decl = backend_decl;
    2052                 :             : 
    2053                 :             :   /* Create a fake symbol for the outer array reference.  */
    2054                 :         683 :   outer_sym = *sym;
    2055                 :         683 :   if (sym->as)
    2056                 :         426 :     outer_sym.as = gfc_copy_array_spec (sym->as);
    2057                 :         683 :   outer_sym.attr.dummy = 0;
    2058                 :         683 :   outer_sym.attr.result = 0;
    2059                 :         683 :   outer_sym.attr.flavor = FL_VARIABLE;
    2060                 :         683 :   outer_sym.backend_decl = outer_decl;
    2061                 :         683 :   if (decl != OMP_CLAUSE_DECL (c))
    2062                 :          12 :     outer_sym.backend_decl = build_fold_indirect_ref (outer_decl);
    2063                 :             : 
    2064                 :             :   /* Create fake symtrees for it.  */
    2065                 :         683 :   symtree1 = gfc_new_symtree (&root1, sym->name);
    2066                 :         683 :   symtree1->n.sym = sym;
    2067                 :         683 :   gcc_assert (symtree1 == root1);
    2068                 :             : 
    2069                 :         683 :   symtree2 = gfc_new_symtree (&root2, sym->name);
    2070                 :         683 :   symtree2->n.sym = &init_val_sym;
    2071                 :         683 :   gcc_assert (symtree2 == root2);
    2072                 :             : 
    2073                 :         683 :   symtree3 = gfc_new_symtree (&root3, sym->name);
    2074                 :         683 :   symtree3->n.sym = &outer_sym;
    2075                 :         683 :   gcc_assert (symtree3 == root3);
    2076                 :             : 
    2077                 :         683 :   memset (omp_var_copy, 0, sizeof omp_var_copy);
    2078                 :         683 :   if (udr)
    2079                 :             :     {
    2080                 :         400 :       omp_var_copy[0] = *udr->omp_out;
    2081                 :         400 :       omp_var_copy[1] = *udr->omp_in;
    2082                 :         400 :       *udr->omp_out = outer_sym;
    2083                 :         400 :       *udr->omp_in = *sym;
    2084                 :         400 :       if (udr->initializer_ns)
    2085                 :             :         {
    2086                 :         270 :           omp_var_copy[2] = *udr->omp_priv;
    2087                 :         270 :           omp_var_copy[3] = *udr->omp_orig;
    2088                 :         270 :           *udr->omp_priv = *sym;
    2089                 :         270 :           *udr->omp_orig = outer_sym;
    2090                 :             :         }
    2091                 :             :     }
    2092                 :             : 
    2093                 :             :   /* Create expressions.  */
    2094                 :         683 :   e1 = gfc_get_expr ();
    2095                 :         683 :   e1->expr_type = EXPR_VARIABLE;
    2096                 :         683 :   e1->where = where;
    2097                 :         683 :   e1->symtree = symtree1;
    2098                 :         683 :   e1->ts = sym->ts;
    2099                 :         683 :   if (sym->attr.dimension)
    2100                 :             :     {
    2101                 :         426 :       e1->ref = ref = gfc_get_ref ();
    2102                 :         426 :       ref->type = REF_ARRAY;
    2103                 :         426 :       ref->u.ar.where = where;
    2104                 :         426 :       ref->u.ar.as = sym->as;
    2105                 :         426 :       ref->u.ar.type = AR_FULL;
    2106                 :         426 :       ref->u.ar.dimen = 0;
    2107                 :             :     }
    2108                 :         683 :   t = gfc_resolve_expr (e1);
    2109                 :         683 :   gcc_assert (t);
    2110                 :             : 
    2111                 :         683 :   e2 = NULL;
    2112                 :         683 :   if (backend_decl != NULL_TREE)
    2113                 :             :     {
    2114                 :         298 :       e2 = gfc_get_expr ();
    2115                 :         298 :       e2->expr_type = EXPR_VARIABLE;
    2116                 :         298 :       e2->where = where;
    2117                 :         298 :       e2->symtree = symtree2;
    2118                 :         298 :       e2->ts = sym->ts;
    2119                 :         298 :       t = gfc_resolve_expr (e2);
    2120                 :         298 :       gcc_assert (t);
    2121                 :             :     }
    2122                 :         385 :   else if (udr->initializer_ns == NULL)
    2123                 :             :     {
    2124                 :         115 :       gcc_assert (sym->ts.type == BT_DERIVED);
    2125                 :         115 :       e2 = gfc_default_initializer (&sym->ts);
    2126                 :         115 :       gcc_assert (e2);
    2127                 :         115 :       t = gfc_resolve_expr (e2);
    2128                 :         115 :       gcc_assert (t);
    2129                 :             :     }
    2130                 :         270 :   else if (n->u2.udr->initializer->op == EXEC_ASSIGN)
    2131                 :             :     {
    2132                 :         204 :       e2 = gfc_copy_expr (n->u2.udr->initializer->expr2);
    2133                 :         204 :       t = gfc_resolve_expr (e2);
    2134                 :         204 :       gcc_assert (t);
    2135                 :             :     }
    2136                 :         683 :   if (udr && udr->initializer_ns)
    2137                 :             :     {
    2138                 :         270 :       struct omp_udr_find_orig_data cd;
    2139                 :         270 :       cd.omp_udr = udr;
    2140                 :         270 :       cd.omp_orig_seen = false;
    2141                 :         270 :       gfc_code_walker (&n->u2.udr->initializer,
    2142                 :             :                        gfc_dummy_code_callback, omp_udr_find_orig, &cd);
    2143                 :         270 :       if (cd.omp_orig_seen)
    2144                 :          72 :         OMP_CLAUSE_REDUCTION_OMP_ORIG_REF (c) = 1;
    2145                 :             :     }
    2146                 :             : 
    2147                 :         683 :   e3 = gfc_copy_expr (e1);
    2148                 :         683 :   e3->symtree = symtree3;
    2149                 :         683 :   t = gfc_resolve_expr (e3);
    2150                 :         683 :   gcc_assert (t);
    2151                 :             : 
    2152                 :         683 :   iname = NULL;
    2153                 :         683 :   e4 = NULL;
    2154                 :         683 :   switch (OMP_CLAUSE_REDUCTION_CODE (c))
    2155                 :             :     {
    2156                 :         159 :     case PLUS_EXPR:
    2157                 :         159 :     case MINUS_EXPR:
    2158                 :         159 :       e4 = gfc_add (e3, e1);
    2159                 :         159 :       break;
    2160                 :          26 :     case MULT_EXPR:
    2161                 :          26 :       e4 = gfc_multiply (e3, e1);
    2162                 :          26 :       break;
    2163                 :           6 :     case TRUTH_ANDIF_EXPR:
    2164                 :           6 :       e4 = gfc_and (e3, e1);
    2165                 :           6 :       break;
    2166                 :           6 :     case TRUTH_ORIF_EXPR:
    2167                 :           6 :       e4 = gfc_or (e3, e1);
    2168                 :           6 :       break;
    2169                 :           6 :     case EQ_EXPR:
    2170                 :           6 :       e4 = gfc_eqv (e3, e1);
    2171                 :           6 :       break;
    2172                 :           6 :     case NE_EXPR:
    2173                 :           6 :       e4 = gfc_neqv (e3, e1);
    2174                 :           6 :       break;
    2175                 :             :     case MIN_EXPR:
    2176                 :             :       iname = "min";
    2177                 :             :       break;
    2178                 :          24 :     case MAX_EXPR:
    2179                 :          24 :       iname = "max";
    2180                 :          24 :       break;
    2181                 :           8 :     case BIT_AND_EXPR:
    2182                 :           8 :       iname = "iand";
    2183                 :           8 :       break;
    2184                 :           6 :     case BIT_IOR_EXPR:
    2185                 :           6 :       iname = "ior";
    2186                 :           6 :       break;
    2187                 :           6 :     case BIT_XOR_EXPR:
    2188                 :           6 :       iname = "ieor";
    2189                 :           6 :       break;
    2190                 :         400 :     case ERROR_MARK:
    2191                 :         400 :       if (n->u2.udr->combiner->op == EXEC_ASSIGN)
    2192                 :             :         {
    2193                 :         334 :           gfc_free_expr (e3);
    2194                 :         334 :           e3 = gfc_copy_expr (n->u2.udr->combiner->expr1);
    2195                 :         334 :           e4 = gfc_copy_expr (n->u2.udr->combiner->expr2);
    2196                 :         334 :           t = gfc_resolve_expr (e3);
    2197                 :         334 :           gcc_assert (t);
    2198                 :         334 :           t = gfc_resolve_expr (e4);
    2199                 :         334 :           gcc_assert (t);
    2200                 :             :         }
    2201                 :             :       break;
    2202                 :           0 :     default:
    2203                 :           0 :       gcc_unreachable ();
    2204                 :             :     }
    2205                 :         683 :   if (iname != NULL)
    2206                 :             :     {
    2207                 :          74 :       memset (&intrinsic_sym, 0, sizeof (intrinsic_sym));
    2208                 :          74 :       intrinsic_sym.ns = sym->ns;
    2209                 :          74 :       intrinsic_sym.name = iname;
    2210                 :          74 :       intrinsic_sym.ts = sym->ts;
    2211                 :          74 :       intrinsic_sym.attr.referenced = 1;
    2212                 :          74 :       intrinsic_sym.attr.intrinsic = 1;
    2213                 :          74 :       intrinsic_sym.attr.function = 1;
    2214                 :          74 :       intrinsic_sym.attr.implicit_type = 1;
    2215                 :          74 :       intrinsic_sym.result = &intrinsic_sym;
    2216                 :          74 :       intrinsic_sym.declared_at = where;
    2217                 :             : 
    2218                 :          74 :       symtree4 = gfc_new_symtree (&root4, iname);
    2219                 :          74 :       symtree4->n.sym = &intrinsic_sym;
    2220                 :          74 :       gcc_assert (symtree4 == root4);
    2221                 :             : 
    2222                 :          74 :       e4 = gfc_get_expr ();
    2223                 :          74 :       e4->expr_type = EXPR_FUNCTION;
    2224                 :          74 :       e4->where = where;
    2225                 :          74 :       e4->symtree = symtree4;
    2226                 :          74 :       e4->value.function.actual = gfc_get_actual_arglist ();
    2227                 :          74 :       e4->value.function.actual->expr = e3;
    2228                 :          74 :       e4->value.function.actual->next = gfc_get_actual_arglist ();
    2229                 :          74 :       e4->value.function.actual->next->expr = e1;
    2230                 :             :     }
    2231                 :         683 :   if (OMP_CLAUSE_REDUCTION_CODE (c) != ERROR_MARK)
    2232                 :             :     {
    2233                 :             :       /* e1 and e3 have been stored as arguments of e4, avoid sharing.  */
    2234                 :         283 :       e1 = gfc_copy_expr (e1);
    2235                 :         283 :       e3 = gfc_copy_expr (e3);
    2236                 :         283 :       t = gfc_resolve_expr (e4);
    2237                 :         283 :       gcc_assert (t);
    2238                 :             :     }
    2239                 :             : 
    2240                 :             :   /* Create the init statement list.  */
    2241                 :         683 :   pushlevel ();
    2242                 :         683 :   if (e2)
    2243                 :         617 :     stmt = gfc_trans_assignment (e1, e2, false, false);
    2244                 :             :   else
    2245                 :          66 :     stmt = gfc_trans_call (n->u2.udr->initializer, false,
    2246                 :             :                            NULL_TREE, NULL_TREE, false);
    2247                 :         683 :   if (TREE_CODE (stmt) != BIND_EXPR)
    2248                 :         154 :     stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0));
    2249                 :             :   else
    2250                 :         529 :     poplevel (0, 0);
    2251                 :         683 :   OMP_CLAUSE_REDUCTION_INIT (c) = stmt;
    2252                 :             : 
    2253                 :             :   /* Create the merge statement list.  */
    2254                 :         683 :   pushlevel ();
    2255                 :         683 :   if (e4)
    2256                 :         617 :     stmt = gfc_trans_assignment (e3, e4, false, true);
    2257                 :             :   else
    2258                 :          66 :     stmt = gfc_trans_call (n->u2.udr->combiner, false,
    2259                 :             :                            NULL_TREE, NULL_TREE, false);
    2260                 :         683 :   if (TREE_CODE (stmt) != BIND_EXPR)
    2261                 :         233 :     stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0));
    2262                 :             :   else
    2263                 :         450 :     poplevel (0, 0);
    2264                 :         683 :   OMP_CLAUSE_REDUCTION_MERGE (c) = stmt;
    2265                 :             : 
    2266                 :             :   /* And stick the placeholder VAR_DECL into the clause as well.  */
    2267                 :         683 :   OMP_CLAUSE_REDUCTION_PLACEHOLDER (c) = outer_decl;
    2268                 :             : 
    2269                 :         683 :   gfc_current_locus = old_loc;
    2270                 :             : 
    2271                 :         683 :   gfc_free_expr (e1);
    2272                 :         683 :   if (e2)
    2273                 :         617 :     gfc_free_expr (e2);
    2274                 :         683 :   gfc_free_expr (e3);
    2275                 :         683 :   if (e4)
    2276                 :         617 :     gfc_free_expr (e4);
    2277                 :         683 :   free (symtree1);
    2278                 :         683 :   free (symtree2);
    2279                 :         683 :   free (symtree3);
    2280                 :         683 :   free (symtree4);
    2281                 :         683 :   if (outer_sym.as)
    2282                 :         426 :     gfc_free_array_spec (outer_sym.as);
    2283                 :             : 
    2284                 :         683 :   if (udr)
    2285                 :             :     {
    2286                 :         400 :       *udr->omp_out = omp_var_copy[0];
    2287                 :         400 :       *udr->omp_in = omp_var_copy[1];
    2288                 :         400 :       if (udr->initializer_ns)
    2289                 :             :         {
    2290                 :         270 :           *udr->omp_priv = omp_var_copy[2];
    2291                 :         270 :           *udr->omp_orig = omp_var_copy[3];
    2292                 :             :         }
    2293                 :             :     }
    2294                 :         683 : }
    2295                 :             : 
    2296                 :             : static tree
    2297                 :        3553 : gfc_trans_omp_reduction_list (int kind, gfc_omp_namelist *namelist, tree list,
    2298                 :             :                               locus where, bool mark_addressable)
    2299                 :             : {
    2300                 :        3553 :   omp_clause_code clause = OMP_CLAUSE_REDUCTION;
    2301                 :        3553 :   switch (kind)
    2302                 :             :     {
    2303                 :             :     case OMP_LIST_REDUCTION:
    2304                 :             :     case OMP_LIST_REDUCTION_INSCAN:
    2305                 :             :     case OMP_LIST_REDUCTION_TASK:
    2306                 :             :       break;
    2307                 :             :     case OMP_LIST_IN_REDUCTION:
    2308                 :             :       clause = OMP_CLAUSE_IN_REDUCTION;
    2309                 :             :       break;
    2310                 :             :     case OMP_LIST_TASK_REDUCTION:
    2311                 :             :       clause = OMP_CLAUSE_TASK_REDUCTION;
    2312                 :             :       break;
    2313                 :           0 :     default:
    2314                 :           0 :       gcc_unreachable ();
    2315                 :             :     }
    2316                 :        8021 :   for (; namelist != NULL; namelist = namelist->next)
    2317                 :        4468 :     if (namelist->sym->attr.referenced)
    2318                 :             :       {
    2319                 :        4468 :         tree t = gfc_trans_omp_variable (namelist->sym, false);
    2320                 :        4468 :         if (t != error_mark_node)
    2321                 :             :           {
    2322                 :        4468 :             tree node = build_omp_clause (gfc_get_location (&namelist->where),
    2323                 :             :                                           clause);
    2324                 :        4468 :             OMP_CLAUSE_DECL (node) = t;
    2325                 :        4468 :             if (mark_addressable)
    2326                 :          37 :               TREE_ADDRESSABLE (t) = 1;
    2327                 :        4468 :             if (kind == OMP_LIST_REDUCTION_INSCAN)
    2328                 :          20 :               OMP_CLAUSE_REDUCTION_INSCAN (node) = 1;
    2329                 :        4468 :             if (kind == OMP_LIST_REDUCTION_TASK)
    2330                 :          91 :               OMP_CLAUSE_REDUCTION_TASK (node) = 1;
    2331                 :        4468 :             switch (namelist->u.reduction_op)
    2332                 :             :               {
    2333                 :        2110 :               case OMP_REDUCTION_PLUS:
    2334                 :        2110 :                 OMP_CLAUSE_REDUCTION_CODE (node) = PLUS_EXPR;
    2335                 :        2110 :                 break;
    2336                 :         147 :               case OMP_REDUCTION_MINUS:
    2337                 :         147 :                 OMP_CLAUSE_REDUCTION_CODE (node) = MINUS_EXPR;
    2338                 :         147 :                 break;
    2339                 :         239 :               case OMP_REDUCTION_TIMES:
    2340                 :         239 :                 OMP_CLAUSE_REDUCTION_CODE (node) = MULT_EXPR;
    2341                 :         239 :                 break;
    2342                 :          90 :               case OMP_REDUCTION_AND:
    2343                 :          90 :                 OMP_CLAUSE_REDUCTION_CODE (node) = TRUTH_ANDIF_EXPR;
    2344                 :          90 :                 break;
    2345                 :         783 :               case OMP_REDUCTION_OR:
    2346                 :         783 :                 OMP_CLAUSE_REDUCTION_CODE (node) = TRUTH_ORIF_EXPR;
    2347                 :         783 :                 break;
    2348                 :          84 :               case OMP_REDUCTION_EQV:
    2349                 :          84 :                 OMP_CLAUSE_REDUCTION_CODE (node) = EQ_EXPR;
    2350                 :          84 :                 break;
    2351                 :          84 :               case OMP_REDUCTION_NEQV:
    2352                 :          84 :                 OMP_CLAUSE_REDUCTION_CODE (node) = NE_EXPR;
    2353                 :          84 :                 break;
    2354                 :         211 :               case OMP_REDUCTION_MAX:
    2355                 :         211 :                 OMP_CLAUSE_REDUCTION_CODE (node) = MAX_EXPR;
    2356                 :         211 :                 break;
    2357                 :         199 :               case OMP_REDUCTION_MIN:
    2358                 :         199 :                 OMP_CLAUSE_REDUCTION_CODE (node) = MIN_EXPR;
    2359                 :         199 :                 break;
    2360                 :          38 :               case OMP_REDUCTION_IAND:
    2361                 :          38 :                 OMP_CLAUSE_REDUCTION_CODE (node) = BIT_AND_EXPR;
    2362                 :          38 :                 break;
    2363                 :          47 :               case OMP_REDUCTION_IOR:
    2364                 :          47 :                 OMP_CLAUSE_REDUCTION_CODE (node) = BIT_IOR_EXPR;
    2365                 :          47 :                 break;
    2366                 :          36 :               case OMP_REDUCTION_IEOR:
    2367                 :          36 :                 OMP_CLAUSE_REDUCTION_CODE (node) = BIT_XOR_EXPR;
    2368                 :          36 :                 break;
    2369                 :         400 :               case OMP_REDUCTION_USER:
    2370                 :         400 :                 OMP_CLAUSE_REDUCTION_CODE (node) = ERROR_MARK;
    2371                 :         400 :                 break;
    2372                 :           0 :               default:
    2373                 :           0 :                 gcc_unreachable ();
    2374                 :             :               }
    2375                 :        4468 :             if (namelist->sym->attr.dimension
    2376                 :        4042 :                 || namelist->u.reduction_op == OMP_REDUCTION_USER
    2377                 :        3798 :                 || namelist->sym->attr.allocatable)
    2378                 :         683 :               gfc_trans_omp_array_reduction_or_udr (node, namelist, where);
    2379                 :        4468 :             list = gfc_trans_add_clause (node, list);
    2380                 :             :           }
    2381                 :             :       }
    2382                 :        3553 :   return list;
    2383                 :             : }
    2384                 :             : 
    2385                 :             : static inline tree
    2386                 :        3129 : gfc_convert_expr_to_tree (stmtblock_t *block, gfc_expr *expr)
    2387                 :             : {
    2388                 :        3129 :   gfc_se se;
    2389                 :        3129 :   tree result;
    2390                 :             : 
    2391                 :        3129 :   gfc_init_se (&se, NULL );
    2392                 :        3129 :   gfc_conv_expr (&se, expr);
    2393                 :        3129 :   gfc_add_block_to_block (block, &se.pre);
    2394                 :        3129 :   result = gfc_evaluate_now (se.expr, block);
    2395                 :        3129 :   gfc_add_block_to_block (block, &se.post);
    2396                 :             : 
    2397                 :        3129 :   return result;
    2398                 :             : }
    2399                 :             : 
    2400                 :             : static vec<tree, va_heap, vl_embed> *doacross_steps;
    2401                 :             : 
    2402                 :             : 
    2403                 :             : /* Translate an array section or array element.  */
    2404                 :             : 
    2405                 :             : static void
    2406                 :        2917 : gfc_trans_omp_array_section (stmtblock_t *block, gfc_exec_op op,
    2407                 :             :                              gfc_omp_namelist *n, tree decl, bool element,
    2408                 :             :                              gomp_map_kind ptr_kind, tree &node, tree &node2,
    2409                 :             :                              tree &node3, tree &node4)
    2410                 :             : {
    2411                 :        2917 :   gfc_se se;
    2412                 :        2917 :   tree ptr, ptr2;
    2413                 :        2917 :   tree elemsz = NULL_TREE;
    2414                 :             : 
    2415                 :        2917 :   gfc_init_se (&se, NULL);
    2416                 :        2917 :   if (element)
    2417                 :             :     {
    2418                 :          68 :       gfc_conv_expr_reference (&se, n->expr);
    2419                 :          68 :       gfc_add_block_to_block (block, &se.pre);
    2420                 :          68 :       ptr = se.expr;
    2421                 :             :     }
    2422                 :             :   else
    2423                 :             :     {
    2424                 :        2849 :       gfc_conv_expr_descriptor (&se, n->expr);
    2425                 :        2849 :       ptr = gfc_conv_array_data (se.expr);
    2426                 :             :     }
    2427                 :        2917 :   if (n->expr->ts.type == BT_CHARACTER && n->expr->ts.deferred)
    2428                 :             :     {
    2429                 :           0 :       gcc_assert (se.string_length);
    2430                 :           0 :       tree len = gfc_evaluate_now (se.string_length, block);
    2431                 :           0 :       elemsz = gfc_get_char_type (n->expr->ts.kind);
    2432                 :           0 :       elemsz = TYPE_SIZE_UNIT (elemsz);
    2433                 :           0 :       elemsz = fold_build2 (MULT_EXPR, size_type_node,
    2434                 :             :                             fold_convert (size_type_node, len), elemsz);
    2435                 :             :     }
    2436                 :        2917 :   if (element)
    2437                 :             :     {
    2438                 :          68 :       if (!elemsz)
    2439                 :          68 :         elemsz = TYPE_SIZE_UNIT (TREE_TYPE (TREE_TYPE (ptr)));
    2440                 :          68 :       OMP_CLAUSE_SIZE (node) = elemsz;
    2441                 :             :     }
    2442                 :             :   else
    2443                 :             :     {
    2444                 :        2849 :       tree type = TREE_TYPE (se.expr);
    2445                 :        2849 :       gfc_add_block_to_block (block, &se.pre);
    2446                 :        2849 :       OMP_CLAUSE_SIZE (node) = gfc_full_array_size (block, se.expr,
    2447                 :        2849 :                                                     GFC_TYPE_ARRAY_RANK (type));
    2448                 :        2849 :       if (!elemsz)
    2449                 :        2849 :         elemsz = TYPE_SIZE_UNIT (gfc_get_element_type (type));
    2450                 :        2849 :       elemsz = fold_convert (gfc_array_index_type, elemsz);
    2451                 :        2849 :       OMP_CLAUSE_SIZE (node) = fold_build2 (MULT_EXPR, gfc_array_index_type,
    2452                 :             :                                             OMP_CLAUSE_SIZE (node), elemsz);
    2453                 :             :     }
    2454                 :        2917 :   gcc_assert (se.post.head == NULL_TREE);
    2455                 :        2917 :   gcc_assert (POINTER_TYPE_P (TREE_TYPE (ptr)));
    2456                 :        2917 :   OMP_CLAUSE_DECL (node) = build_fold_indirect_ref (ptr);
    2457                 :        2917 :   ptr = fold_convert (ptrdiff_type_node, ptr);
    2458                 :             : 
    2459                 :        5605 :   if (POINTER_TYPE_P (TREE_TYPE (decl))
    2460                 :         307 :       && GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (TREE_TYPE (decl)))
    2461                 :          78 :       && ptr_kind == GOMP_MAP_POINTER
    2462                 :          78 :       && op != EXEC_OMP_TARGET_EXIT_DATA
    2463                 :          78 :       && OMP_CLAUSE_MAP_KIND (node) != GOMP_MAP_RELEASE
    2464                 :        2995 :       && OMP_CLAUSE_MAP_KIND (node) != GOMP_MAP_DELETE)
    2465                 :             : 
    2466                 :             :     {
    2467                 :          78 :       node4 = build_omp_clause (input_location,
    2468                 :             :                                 OMP_CLAUSE_MAP);
    2469                 :          78 :       OMP_CLAUSE_SET_MAP_KIND (node4, GOMP_MAP_POINTER);
    2470                 :          78 :       OMP_CLAUSE_DECL (node4) = decl;
    2471                 :          78 :       OMP_CLAUSE_SIZE (node4) = size_int (0);
    2472                 :          78 :       decl = build_fold_indirect_ref (decl);
    2473                 :             :     }
    2474                 :        2839 :   else if (ptr_kind == GOMP_MAP_ALWAYS_POINTER
    2475                 :         106 :            && n->expr->ts.type == BT_CHARACTER
    2476                 :          48 :            && n->expr->ts.deferred)
    2477                 :             :     {
    2478                 :           0 :       gomp_map_kind map_kind;
    2479                 :           0 :       if (OMP_CLAUSE_MAP_KIND (node) == GOMP_MAP_DELETE)
    2480                 :           0 :         map_kind = OMP_CLAUSE_MAP_KIND (node);
    2481                 :           0 :       else if (op == EXEC_OMP_TARGET_EXIT_DATA
    2482                 :           0 :                || OMP_CLAUSE_MAP_KIND (node) == GOMP_MAP_RELEASE)
    2483                 :             :         map_kind = GOMP_MAP_RELEASE;
    2484                 :             :       else
    2485                 :             :         map_kind = GOMP_MAP_TO;
    2486                 :           0 :       gcc_assert (se.string_length);
    2487                 :           0 :       node4 = build_omp_clause (input_location, OMP_CLAUSE_MAP);
    2488                 :           0 :       OMP_CLAUSE_SET_MAP_KIND (node4, map_kind);
    2489                 :           0 :       OMP_CLAUSE_DECL (node4) = se.string_length;
    2490                 :           0 :       OMP_CLAUSE_SIZE (node4) = TYPE_SIZE_UNIT (gfc_charlen_type_node);
    2491                 :             :     }
    2492                 :        2917 :   if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (decl)))
    2493                 :             :     {
    2494                 :        1770 :       tree desc_node;
    2495                 :        1770 :       tree type = TREE_TYPE (decl);
    2496                 :        1770 :       ptr2 = gfc_conv_descriptor_data_get (decl);
    2497                 :        1770 :       desc_node = build_omp_clause (input_location, OMP_CLAUSE_MAP);
    2498                 :        1770 :       OMP_CLAUSE_DECL (desc_node) = decl;
    2499                 :        1770 :       OMP_CLAUSE_SIZE (desc_node) = TYPE_SIZE_UNIT (type);
    2500                 :        1770 :       if (OMP_CLAUSE_MAP_KIND (node) == GOMP_MAP_DELETE)
    2501                 :             :         {
    2502                 :           0 :           OMP_CLAUSE_SET_MAP_KIND (desc_node, GOMP_MAP_DELETE);
    2503                 :           0 :           node2 = desc_node;
    2504                 :             :         }
    2505                 :        1770 :       else if (OMP_CLAUSE_MAP_KIND (node) == GOMP_MAP_RELEASE
    2506                 :        1770 :                || op == EXEC_OMP_TARGET_EXIT_DATA)
    2507                 :             :         {
    2508                 :         137 :           OMP_CLAUSE_SET_MAP_KIND (desc_node, GOMP_MAP_RELEASE);
    2509                 :         137 :           node2 = desc_node;
    2510                 :             :         }
    2511                 :        1633 :       else if (ptr_kind == GOMP_MAP_ALWAYS_POINTER)
    2512                 :             :         {
    2513                 :          28 :           OMP_CLAUSE_SET_MAP_KIND (desc_node, GOMP_MAP_TO);
    2514                 :          28 :           node2 = node;
    2515                 :          28 :           node = desc_node;  /* Needs to come first.  */
    2516                 :             :         }
    2517                 :             :       else
    2518                 :             :         {
    2519                 :        1605 :           OMP_CLAUSE_SET_MAP_KIND (desc_node, GOMP_MAP_TO_PSET);
    2520                 :        1605 :           node2 = desc_node;
    2521                 :             :         }
    2522                 :        1770 :       if (op == EXEC_OMP_TARGET_EXIT_DATA)
    2523                 :          80 :         return;
    2524                 :        1767 :       node3 = build_omp_clause (input_location, OMP_CLAUSE_MAP);
    2525                 :        1767 :       OMP_CLAUSE_SET_MAP_KIND (node3, ptr_kind);
    2526                 :        1767 :       OMP_CLAUSE_DECL (node3) = gfc_conv_descriptor_data_get (decl);
    2527                 :             :       /* This purposely does not include GOMP_MAP_ALWAYS_POINTER.  The extra
    2528                 :             :          cast prevents gimplify.cc from recognising it as being part of the
    2529                 :             :          struct - and adding an 'alloc: for the 'desc.data' pointer, which
    2530                 :             :          would break as the 'desc' (the descriptor) is also mapped
    2531                 :             :          (see node4 above).  */
    2532                 :        1767 :       if (ptr_kind == GOMP_MAP_ATTACH_DETACH)
    2533                 :         137 :         STRIP_NOPS (OMP_CLAUSE_DECL (node3));
    2534                 :             :     }
    2535                 :             :   else
    2536                 :             :     {
    2537                 :        1147 :       if (TREE_CODE (TREE_TYPE (decl)) == ARRAY_TYPE)
    2538                 :             :         {
    2539                 :         918 :           tree offset;
    2540                 :         918 :           ptr2 = build_fold_addr_expr (decl);
    2541                 :         918 :           offset = fold_build2 (MINUS_EXPR, ptrdiff_type_node, ptr,
    2542                 :             :                                 fold_convert (ptrdiff_type_node, ptr2));
    2543                 :         918 :           offset = build2 (TRUNC_DIV_EXPR, ptrdiff_type_node,
    2544                 :             :                            offset, fold_convert (ptrdiff_type_node, elemsz));
    2545                 :         918 :           offset = build4_loc (input_location, ARRAY_REF,
    2546                 :         918 :                                TREE_TYPE (TREE_TYPE (decl)),
    2547                 :             :                                decl, offset, NULL_TREE, NULL_TREE);
    2548                 :         918 :           OMP_CLAUSE_DECL (node) = offset;
    2549                 :             : 
    2550                 :         918 :           if (ptr_kind == GOMP_MAP_ALWAYS_POINTER)
    2551                 :             :             return;
    2552                 :             :         }
    2553                 :             :       else
    2554                 :             :         {
    2555                 :         229 :           gcc_assert (POINTER_TYPE_P (TREE_TYPE (decl)));
    2556                 :             :           ptr2 = decl;
    2557                 :             :         }
    2558                 :        1070 :       node3 = build_omp_clause (input_location,
    2559                 :             :                                 OMP_CLAUSE_MAP);
    2560                 :        1070 :       OMP_CLAUSE_SET_MAP_KIND (node3, ptr_kind);
    2561                 :        1070 :       OMP_CLAUSE_DECL (node3) = decl;
    2562                 :             :     }
    2563                 :        2837 :   ptr2 = fold_convert (ptrdiff_type_node, ptr2);
    2564                 :        2837 :   OMP_CLAUSE_SIZE (node3) = fold_build2 (MINUS_EXPR, ptrdiff_type_node,
    2565                 :             :                                          ptr, ptr2);
    2566                 :             : }
    2567                 :             : 
    2568                 :             : static tree
    2569                 :          43 : handle_iterator (gfc_namespace *ns, stmtblock_t *iter_block, tree block)
    2570                 :             : {
    2571                 :          43 :   tree list = NULL_TREE;
    2572                 :          88 :   for (gfc_symbol *sym = ns->omp_affinity_iterators; sym; sym = sym->tlink)
    2573                 :             :     {
    2574                 :          45 :       gfc_constructor *c;
    2575                 :          45 :       gfc_se se;
    2576                 :             : 
    2577                 :          45 :       tree last = make_tree_vec (6);
    2578                 :          45 :       tree iter_var = gfc_get_symbol_decl (sym);
    2579                 :          45 :       tree type = TREE_TYPE (iter_var);
    2580                 :          45 :       TREE_VEC_ELT (last, 0) = iter_var;
    2581                 :          45 :       DECL_CHAIN (iter_var) = BLOCK_VARS (block);
    2582                 :          45 :       BLOCK_VARS (block) = iter_var;
    2583                 :             : 
    2584                 :             :       /* begin */
    2585                 :          45 :       c = gfc_constructor_first (sym->value->value.constructor);
    2586                 :          45 :       gfc_init_se (&se, NULL);
    2587                 :          45 :       gfc_conv_expr (&se, c->expr);
    2588                 :          45 :       gfc_add_block_to_block (iter_block, &se.pre);
    2589                 :          45 :       gfc_add_block_to_block (iter_block, &se.post);
    2590                 :          45 :       TREE_VEC_ELT (last, 1) = fold_convert (type,
    2591                 :             :                                              gfc_evaluate_now (se.expr,
    2592                 :             :                                                                iter_block));
    2593                 :             :       /* end */
    2594                 :          45 :       c = gfc_constructor_next (c);
    2595                 :          45 :       gfc_init_se (&se, NULL);
    2596                 :          45 :       gfc_conv_expr (&se, c->expr);
    2597                 :          45 :       gfc_add_block_to_block (iter_block, &se.pre);
    2598                 :          45 :       gfc_add_block_to_block (iter_block, &se.post);
    2599                 :          45 :       TREE_VEC_ELT (last, 2) = fold_convert (type,
    2600                 :             :                                              gfc_evaluate_now (se.expr,
    2601                 :             :                                                                iter_block));
    2602                 :             :       /* step */
    2603                 :          45 :       c = gfc_constructor_next (c);
    2604                 :          45 :       tree step;
    2605                 :          45 :       if (c)
    2606                 :             :         {
    2607                 :           5 :           gfc_init_se (&se, NULL);
    2608                 :           5 :           gfc_conv_expr (&se, c->expr);
    2609                 :           5 :           gfc_add_block_to_block (iter_block, &se.pre);
    2610                 :           5 :           gfc_add_block_to_block (iter_block, &se.post);
    2611                 :           5 :           gfc_conv_expr (&se, c->expr);
    2612                 :           5 :           step = fold_convert (type,
    2613                 :             :                                gfc_evaluate_now (se.expr,
    2614                 :             :                                                  iter_block));
    2615                 :             :         }
    2616                 :             :       else
    2617                 :          40 :         step = build_int_cst (type, 1);
    2618                 :          45 :       TREE_VEC_ELT (last, 3) = step;
    2619                 :             :       /* orig_step */
    2620                 :          45 :       TREE_VEC_ELT (last, 4) = save_expr (step);
    2621                 :          45 :       TREE_CHAIN (last) = list;
    2622                 :          45 :       list = last;
    2623                 :             :     }
    2624                 :          43 :   return list;
    2625                 :             : }
    2626                 :             : 
    2627                 :             : static tree
    2628                 :       28086 : gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
    2629                 :             :                        locus where, bool declare_simd = false,
    2630                 :             :                        bool openacc = false, gfc_exec_op op = EXEC_NOP)
    2631                 :             : {
    2632                 :       28086 :   tree omp_clauses = NULL_TREE, prev_clauses, chunk_size, c;
    2633                 :       28086 :   tree iterator = NULL_TREE;
    2634                 :       28086 :   tree tree_block = NULL_TREE;
    2635                 :       28086 :   stmtblock_t iter_block;
    2636                 :       28086 :   int list, ifc;
    2637                 :       28086 :   enum omp_clause_code clause_code;
    2638                 :       28086 :   gfc_omp_namelist *prev = NULL;
    2639                 :       28086 :   gfc_se se;
    2640                 :             : 
    2641                 :       28086 :   if (clauses == NULL)
    2642                 :             :     return NULL_TREE;
    2643                 :             : 
    2644                 :      954516 :   for (list = 0; list < OMP_LIST_NUM; list++)
    2645                 :             :     {
    2646                 :      926442 :       gfc_omp_namelist *n = clauses->lists[list];
    2647                 :             : 
    2648                 :      926442 :       if (n == NULL)
    2649                 :      901167 :         continue;
    2650                 :       25275 :       switch (list)
    2651                 :             :         {
    2652                 :        3553 :         case OMP_LIST_REDUCTION:
    2653                 :        3553 :         case OMP_LIST_REDUCTION_INSCAN:
    2654                 :        3553 :         case OMP_LIST_REDUCTION_TASK:
    2655                 :        3553 :         case OMP_LIST_IN_REDUCTION:
    2656                 :        3553 :         case OMP_LIST_TASK_REDUCTION:
    2657                 :             :           /* An OpenACC async clause indicates the need to set reduction
    2658                 :             :              arguments addressable, to allow asynchronous copy-out.  */
    2659                 :        3553 :           omp_clauses = gfc_trans_omp_reduction_list (list, n, omp_clauses,
    2660                 :        3553 :                                                       where, clauses->async);
    2661                 :        3553 :           break;
    2662                 :        5678 :         case OMP_LIST_PRIVATE:
    2663                 :        5678 :           clause_code = OMP_CLAUSE_PRIVATE;
    2664                 :        5678 :           goto add_clause;
    2665                 :        1057 :         case OMP_LIST_SHARED:
    2666                 :        1057 :           clause_code = OMP_CLAUSE_SHARED;
    2667                 :        1057 :           goto add_clause;
    2668                 :        1038 :         case OMP_LIST_FIRSTPRIVATE:
    2669                 :        1038 :           clause_code = OMP_CLAUSE_FIRSTPRIVATE;
    2670                 :        1038 :           goto add_clause;
    2671                 :        1619 :         case OMP_LIST_LASTPRIVATE:
    2672                 :        1619 :           clause_code = OMP_CLAUSE_LASTPRIVATE;
    2673                 :        1619 :           goto add_clause;
    2674                 :          96 :         case OMP_LIST_COPYIN:
    2675                 :          96 :           clause_code = OMP_CLAUSE_COPYIN;
    2676                 :          96 :           goto add_clause;
    2677                 :          74 :         case OMP_LIST_COPYPRIVATE:
    2678                 :          74 :           clause_code = OMP_CLAUSE_COPYPRIVATE;
    2679                 :          74 :           goto add_clause;
    2680                 :          66 :         case OMP_LIST_UNIFORM:
    2681                 :          66 :           clause_code = OMP_CLAUSE_UNIFORM;
    2682                 :          66 :           goto add_clause;
    2683                 :          49 :         case OMP_LIST_USE_DEVICE:
    2684                 :          49 :         case OMP_LIST_USE_DEVICE_PTR:
    2685                 :          49 :           clause_code = OMP_CLAUSE_USE_DEVICE_PTR;
    2686                 :          49 :           goto add_clause;
    2687                 :         921 :         case OMP_LIST_USE_DEVICE_ADDR:
    2688                 :         921 :           clause_code = OMP_CLAUSE_USE_DEVICE_ADDR;
    2689                 :         921 :           goto add_clause;
    2690                 :          27 :         case OMP_LIST_IS_DEVICE_PTR:
    2691                 :          27 :           clause_code = OMP_CLAUSE_IS_DEVICE_PTR;
    2692                 :          27 :           goto add_clause;
    2693                 :          97 :         case OMP_LIST_HAS_DEVICE_ADDR:
    2694                 :          97 :           clause_code = OMP_CLAUSE_HAS_DEVICE_ADDR;
    2695                 :          97 :           goto add_clause;
    2696                 :           2 :         case OMP_LIST_NONTEMPORAL:
    2697                 :           2 :           clause_code = OMP_CLAUSE_NONTEMPORAL;
    2698                 :           2 :           goto add_clause;
    2699                 :           9 :         case OMP_LIST_SCAN_IN:
    2700                 :           9 :           clause_code = OMP_CLAUSE_INCLUSIVE;
    2701                 :           9 :           goto add_clause;
    2702                 :           7 :         case OMP_LIST_SCAN_EX:
    2703                 :           7 :           clause_code = OMP_CLAUSE_EXCLUSIVE;
    2704                 :           7 :           goto add_clause;
    2705                 :             : 
    2706                 :       10740 :         add_clause:
    2707                 :       10740 :           omp_clauses
    2708                 :       10740 :             = gfc_trans_omp_variable_list (clause_code, n, omp_clauses,
    2709                 :             :                                            declare_simd);
    2710                 :       10740 :           break;
    2711                 :             :         case OMP_LIST_ALIGNED:
    2712                 :         256 :           for (; n != NULL; n = n->next)
    2713                 :         149 :             if (n->sym->attr.referenced || declare_simd)
    2714                 :             :               {
    2715                 :         149 :                 tree t = gfc_trans_omp_variable (n->sym, declare_simd);
    2716                 :         149 :                 if (t != error_mark_node)
    2717                 :             :                   {
    2718                 :         149 :                     tree node = build_omp_clause (input_location,
    2719                 :             :                                                   OMP_CLAUSE_ALIGNED);
    2720                 :         149 :                     OMP_CLAUSE_DECL (node) = t;
    2721                 :         149 :                     if (n->expr)
    2722                 :             :                       {
    2723                 :         148 :                         tree alignment_var;
    2724                 :             : 
    2725                 :         148 :                         if (declare_simd)
    2726                 :           5 :                           alignment_var = gfc_conv_constant_to_tree (n->expr);
    2727                 :             :                         else
    2728                 :             :                           {
    2729                 :         143 :                             gfc_init_se (&se, NULL);
    2730                 :         143 :                             gfc_conv_expr (&se, n->expr);
    2731                 :         143 :                             gfc_add_block_to_block (block, &se.pre);
    2732                 :         143 :                             alignment_var = gfc_evaluate_now (se.expr, block);
    2733                 :         143 :                             gfc_add_block_to_block (block, &se.post);
    2734                 :             :                           }
    2735                 :         148 :                         OMP_CLAUSE_ALIGNED_ALIGNMENT (node) = alignment_var;
    2736                 :             :                       }
    2737                 :         149 :                     omp_clauses = gfc_trans_add_clause (node, omp_clauses);
    2738                 :             :                   }
    2739                 :             :               }
    2740                 :             :           break;
    2741                 :             :         case OMP_LIST_ALLOCATE:
    2742                 :         568 :           for (; n != NULL; n = n->next)
    2743                 :         369 :             if (n->sym->attr.referenced)
    2744                 :             :               {
    2745                 :         369 :                 tree t = gfc_trans_omp_variable (n->sym, false);
    2746                 :         369 :                 if (t != error_mark_node)
    2747                 :             :                   {
    2748                 :         369 :                     tree node = build_omp_clause (input_location,
    2749                 :             :                                                   OMP_CLAUSE_ALLOCATE);
    2750                 :         369 :                     OMP_CLAUSE_DECL (node) = t;
    2751                 :         369 :                     if (n->u2.allocator)
    2752                 :             :                       {
    2753                 :         234 :                         tree allocator_;
    2754                 :         234 :                         gfc_init_se (&se, NULL);
    2755                 :         234 :                         gfc_conv_expr (&se, n->u2.allocator);
    2756                 :         234 :                         allocator_ = gfc_evaluate_now (se.expr, block);
    2757                 :         234 :                         OMP_CLAUSE_ALLOCATE_ALLOCATOR (node) = allocator_;
    2758                 :             :                       }
    2759                 :         369 :                     if (n->u.align)
    2760                 :             :                       {
    2761                 :           3 :                         tree align_;
    2762                 :           3 :                         gfc_init_se (&se, NULL);
    2763                 :           3 :                         gfc_conv_expr (&se, n->u.align);
    2764                 :           3 :                         align_ = gfc_evaluate_now (se.expr, block);
    2765                 :           3 :                         OMP_CLAUSE_ALLOCATE_ALIGN (node) = align_;
    2766                 :             :                       }
    2767                 :         369 :                     omp_clauses = gfc_trans_add_clause (node, omp_clauses);
    2768                 :             :                   }
    2769                 :             :               }
    2770                 :             :           break;
    2771                 :             :         case OMP_LIST_LINEAR:
    2772                 :             :           {
    2773                 :             :             gfc_expr *last_step_expr = NULL;
    2774                 :             :             tree last_step = NULL_TREE;
    2775                 :             :             bool last_step_parm = false;
    2776                 :             : 
    2777                 :        1298 :             for (; n != NULL; n = n->next)
    2778                 :             :               {
    2779                 :         800 :                 if (n->expr)
    2780                 :             :                   {
    2781                 :         781 :                     last_step_expr = n->expr;
    2782                 :         781 :                     last_step = NULL_TREE;
    2783                 :         781 :                     last_step_parm = false;
    2784                 :             :                   }
    2785                 :         800 :                 if (n->sym->attr.referenced || declare_simd)
    2786                 :             :                   {
    2787                 :         800 :                     tree t = gfc_trans_omp_variable (n->sym, declare_simd);
    2788                 :         800 :                     if (t != error_mark_node)
    2789                 :             :                       {
    2790                 :         800 :                         tree node = build_omp_clause (input_location,
    2791                 :             :                                                       OMP_CLAUSE_LINEAR);
    2792                 :         800 :                         OMP_CLAUSE_DECL (node) = t;
    2793                 :         800 :                         omp_clause_linear_kind kind;
    2794                 :         800 :                         switch (n->u.linear.op)
    2795                 :             :                           {
    2796                 :             :                           case OMP_LINEAR_DEFAULT:
    2797                 :             :                             kind = OMP_CLAUSE_LINEAR_DEFAULT;
    2798                 :             :                             break;
    2799                 :             :                           case OMP_LINEAR_REF:
    2800                 :             :                             kind = OMP_CLAUSE_LINEAR_REF;
    2801                 :             :                             break;
    2802                 :             :                           case OMP_LINEAR_VAL:
    2803                 :             :                             kind = OMP_CLAUSE_LINEAR_VAL;
    2804                 :             :                             break;
    2805                 :             :                           case OMP_LINEAR_UVAL:
    2806                 :             :                             kind = OMP_CLAUSE_LINEAR_UVAL;
    2807                 :             :                             break;
    2808                 :           0 :                           default:
    2809                 :           0 :                             gcc_unreachable ();
    2810                 :             :                           }
    2811                 :         800 :                         OMP_CLAUSE_LINEAR_KIND (node) = kind;
    2812                 :         800 :                         OMP_CLAUSE_LINEAR_OLD_LINEAR_MODIFIER (node)
    2813                 :         800 :                           = n->u.linear.old_modifier;
    2814                 :         800 :                         if (last_step_expr && last_step == NULL_TREE)
    2815                 :             :                           {
    2816                 :         781 :                             if (!declare_simd)
    2817                 :             :                               {
    2818                 :         695 :                                 gfc_init_se (&se, NULL);
    2819                 :         695 :                                 gfc_conv_expr (&se, last_step_expr);
    2820                 :         695 :                                 gfc_add_block_to_block (block, &se.pre);
    2821                 :         695 :                                 last_step = gfc_evaluate_now (se.expr, block);
    2822                 :         695 :                                 gfc_add_block_to_block (block, &se.post);
    2823                 :             :                               }
    2824                 :          86 :                             else if (last_step_expr->expr_type == EXPR_VARIABLE)
    2825                 :             :                               {
    2826                 :           2 :                                 gfc_symbol *s = last_step_expr->symtree->n.sym;
    2827                 :           2 :                                 last_step = gfc_trans_omp_variable (s, true);
    2828                 :           2 :                                 last_step_parm = true;
    2829                 :             :                               }
    2830                 :             :                             else
    2831                 :          84 :                               last_step
    2832                 :          84 :                                 = gfc_conv_constant_to_tree (last_step_expr);
    2833                 :             :                           }
    2834                 :         800 :                         if (last_step_parm)
    2835                 :             :                           {
    2836                 :           2 :                             OMP_CLAUSE_LINEAR_VARIABLE_STRIDE (node) = 1;
    2837                 :           2 :                             OMP_CLAUSE_LINEAR_STEP (node) = last_step;
    2838                 :             :                           }
    2839                 :             :                         else
    2840                 :             :                           {
    2841                 :         798 :                             if (kind == OMP_CLAUSE_LINEAR_REF)
    2842                 :             :                               {
    2843                 :          34 :                                 tree type;
    2844                 :          34 :                                 if (n->sym->attr.flavor == FL_PROCEDURE)
    2845                 :             :                                   {
    2846                 :           0 :                                     type = gfc_get_function_type (n->sym);
    2847                 :           0 :                                     type = build_pointer_type (type);
    2848                 :             :                                   }
    2849                 :             :                                 else
    2850                 :          34 :                                   type = gfc_sym_type (n->sym);
    2851                 :          34 :                                 if (POINTER_TYPE_P (type))
    2852                 :          34 :                                   type = TREE_TYPE (type);
    2853                 :             :                                 /* Otherwise to be determined what exactly
    2854                 :             :                                    should be done.  */
    2855                 :          34 :                                 tree t = fold_convert (sizetype, last_step);
    2856                 :          34 :                                 t = size_binop (MULT_EXPR, t,
    2857                 :             :                                                 TYPE_SIZE_UNIT (type));
    2858                 :          34 :                                 OMP_CLAUSE_LINEAR_STEP (node) = t;
    2859                 :             :                               }
    2860                 :             :                             else
    2861                 :             :                               {
    2862                 :         764 :                                 tree type
    2863                 :         764 :                                   = gfc_typenode_for_spec (&n->sym->ts);
    2864                 :         764 :                                 OMP_CLAUSE_LINEAR_STEP (node)
    2865                 :        1528 :                                   = fold_convert (type, last_step);
    2866                 :             :                               }
    2867                 :             :                           }
    2868                 :         800 :                         if (n->sym->attr.dimension || n->sym->attr.allocatable)
    2869                 :         222 :                           OMP_CLAUSE_LINEAR_ARRAY (node) = 1;
    2870                 :         800 :                         omp_clauses = gfc_trans_add_clause (node, omp_clauses);
    2871                 :             :                       }
    2872                 :             :                   }
    2873                 :             :               }
    2874                 :             :           }
    2875                 :             :           break;
    2876                 :             :         case OMP_LIST_AFFINITY:
    2877                 :             :         case OMP_LIST_DEPEND:
    2878                 :             :           iterator = NULL_TREE;
    2879                 :             :           prev = NULL;
    2880                 :             :           prev_clauses = omp_clauses;
    2881                 :        1554 :           for (; n != NULL; n = n->next)
    2882                 :             :             {
    2883                 :         841 :               if (iterator && prev->u2.ns != n->u2.ns)
    2884                 :             :                 { 
    2885                 :          12 :                   BLOCK_SUBBLOCKS (tree_block) = gfc_finish_block (&iter_block);
    2886                 :          12 :                   TREE_VEC_ELT (iterator, 5) = tree_block;
    2887                 :          26 :                   for (tree c = omp_clauses; c != prev_clauses;
    2888                 :          14 :                        c = OMP_CLAUSE_CHAIN (c))
    2889                 :          28 :                     OMP_CLAUSE_DECL (c) = build_tree_list (iterator,
    2890                 :          14 :                                                            OMP_CLAUSE_DECL (c));
    2891                 :             :                   prev_clauses = omp_clauses;
    2892                 :             :                   iterator = NULL_TREE;
    2893                 :             :                 }
    2894                 :         841 :               if (n->u2.ns && (!prev || prev->u2.ns != n->u2.ns))
    2895                 :             :                 {
    2896                 :          43 :                   gfc_init_block (&iter_block);
    2897                 :          43 :                   tree_block = make_node (BLOCK);
    2898                 :          43 :                   TREE_USED (tree_block) = 1;
    2899                 :          43 :                   BLOCK_VARS (tree_block) = NULL_TREE;
    2900                 :          43 :                   iterator = handle_iterator (n->u2.ns, block,
    2901                 :             :                                               tree_block);
    2902                 :             :                 }
    2903                 :         841 :               if (!iterator)
    2904                 :         789 :                 gfc_init_block (&iter_block);
    2905                 :         841 :               prev = n;
    2906                 :         841 :               if (list == OMP_LIST_DEPEND
    2907                 :         815 :                   && (n->u.depend_doacross_op == OMP_DOACROSS_SINK_FIRST
    2908                 :         815 :                       || n->u.depend_doacross_op == OMP_DEPEND_SINK_FIRST))
    2909                 :             :                 {
    2910                 :         227 :                   tree vec = NULL_TREE;
    2911                 :         227 :                   unsigned int i;
    2912                 :         227 :                   bool is_depend
    2913                 :             :                     = n->u.depend_doacross_op == OMP_DEPEND_SINK_FIRST;
    2914                 :         227 :                   for (i = 0; ; i++)
    2915                 :             :                     {
    2916                 :        1218 :                       tree addend = integer_zero_node, t;
    2917                 :        1218 :                       bool neg = false;
    2918                 :        1218 :                       if (n->sym && n->expr)
    2919                 :             :                         {
    2920                 :         558 :                           addend = gfc_conv_constant_to_tree (n->expr);
    2921                 :         558 :                           if (TREE_CODE (addend) == INTEGER_CST
    2922                 :         558 :                               && tree_int_cst_sgn (addend) == -1)
    2923                 :             :                             {
    2924                 :         407 :                               neg = true;
    2925                 :         407 :                               addend = const_unop (NEGATE_EXPR,
    2926                 :         407 :                                                    TREE_TYPE (addend), addend);
    2927                 :             :                             }
    2928                 :             :                         }
    2929                 :             : 
    2930                 :        1218 :                       if (n->sym == NULL)
    2931                 :           0 :                         t = null_pointer_node;  /* "omp_cur_iteration - 1".  */
    2932                 :             :                       else
    2933                 :        1218 :                         t = gfc_trans_omp_variable (n->sym, false);
    2934                 :        1218 :                       if (t != error_mark_node)
    2935                 :             :                         {
    2936                 :        1218 :                           if (i < vec_safe_length (doacross_steps)
    2937                 :         426 :                               && !integer_zerop (addend)
    2938                 :         630 :                               && (*doacross_steps)[i])
    2939                 :             :                             {
    2940                 :         204 :                               tree step = (*doacross_steps)[i];
    2941                 :         204 :                               addend = fold_convert (TREE_TYPE (step), addend);
    2942                 :         204 :                               addend = build2 (TRUNC_DIV_EXPR,
    2943                 :         204 :                                                TREE_TYPE (step), addend, step);
    2944                 :             :                             }
    2945                 :        1218 :                           vec = tree_cons (addend, t, vec);
    2946                 :        1218 :                           if (neg)
    2947                 :         407 :                             OMP_CLAUSE_DOACROSS_SINK_NEGATIVE (vec) = 1;
    2948                 :             :                         }
    2949                 :        1218 :                       if (n->next == NULL
    2950                 :        1057 :                           || n->next->u.depend_doacross_op != OMP_DOACROSS_SINK)
    2951                 :             :                         break;
    2952                 :         991 :                       n = n->next;
    2953                 :         991 :                     }
    2954                 :         227 :                   if (vec == NULL_TREE)
    2955                 :           0 :                     continue;
    2956                 :             : 
    2957                 :         227 :                   tree node = build_omp_clause (input_location,
    2958                 :             :                                                 OMP_CLAUSE_DOACROSS);
    2959                 :         227 :                   OMP_CLAUSE_DOACROSS_KIND (node) = OMP_CLAUSE_DOACROSS_SINK;
    2960                 :         227 :                   OMP_CLAUSE_DOACROSS_DEPEND (node) = is_depend;
    2961                 :         227 :                   OMP_CLAUSE_DECL (node) = nreverse (vec);
    2962                 :         227 :                   omp_clauses = gfc_trans_add_clause (node, omp_clauses);
    2963                 :         227 :                   continue;
    2964                 :         227 :                 }
    2965                 :             : 
    2966                 :         614 :               if (n->sym && !n->sym->attr.referenced)
    2967                 :           0 :                 continue;
    2968                 :             : 
    2969                 :         640 :               tree node = build_omp_clause (input_location,
    2970                 :             :                                             list == OMP_LIST_DEPEND
    2971                 :             :                                             ? OMP_CLAUSE_DEPEND
    2972                 :             :                                             : OMP_CLAUSE_AFFINITY);
    2973                 :         614 :               if (n->sym == NULL)  /* omp_all_memory  */
    2974                 :           9 :                 OMP_CLAUSE_DECL (node) = null_pointer_node;
    2975                 :         605 :               else if (n->expr == NULL || n->expr->ref->u.ar.type == AR_FULL)
    2976                 :             :                 {
    2977                 :         396 :                   tree decl = gfc_trans_omp_variable (n->sym, false);
    2978                 :         396 :                   if (gfc_omp_privatize_by_reference (decl))
    2979                 :          60 :                     decl = build_fold_indirect_ref (decl);
    2980                 :         396 :                   if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (decl)))
    2981                 :             :                     {
    2982                 :          23 :                       decl = gfc_conv_descriptor_data_get (decl);
    2983                 :          23 :                       gcc_assert (POINTER_TYPE_P (TREE_TYPE (decl)));
    2984                 :          23 :                       decl = build_fold_indirect_ref (decl);
    2985                 :             :                     }
    2986                 :         373 :                   else if (n->sym->attr.allocatable || n->sym->attr.pointer)
    2987                 :          22 :                     decl = build_fold_indirect_ref (decl);
    2988                 :         351 :                   else if (DECL_P (decl))
    2989                 :         320 :                     TREE_ADDRESSABLE (decl) = 1;
    2990                 :         396 :                   OMP_CLAUSE_DECL (node) = decl;
    2991                 :         396 :                 }
    2992                 :             :               else
    2993                 :             :                 {
    2994                 :         209 :                   tree ptr;
    2995                 :         209 :                   gfc_init_se (&se, NULL);
    2996                 :         209 :                   if (n->expr->ref->u.ar.type == AR_ELEMENT)
    2997                 :             :                     {
    2998                 :         130 :                       gfc_conv_expr_reference (&se, n->expr);
    2999                 :         130 :                       ptr = se.expr;
    3000                 :             :                     }
    3001                 :             :                   else
    3002                 :             :                     {
    3003                 :          79 :                       gfc_conv_expr_descriptor (&se, n->expr);
    3004                 :          79 :                       ptr = gfc_conv_array_data (se.expr);
    3005                 :             :                     }
    3006                 :         209 :                   gfc_add_block_to_block (&iter_block, &se.pre);
    3007                 :         209 :                   gfc_add_block_to_block (&iter_block, &se.post);
    3008                 :         209 :                   gcc_assert (POINTER_TYPE_P (TREE_TYPE (ptr)));
    3009                 :         209 :                   OMP_CLAUSE_DECL (node) = build_fold_indirect_ref (ptr);
    3010                 :             :                 }
    3011                 :         614 :               if (list == OMP_LIST_DEPEND)
    3012                 :         588 :                 switch (n->u.depend_doacross_op)
    3013                 :             :                   {
    3014                 :         224 :                   case OMP_DEPEND_IN:
    3015                 :         224 :                     OMP_CLAUSE_DEPEND_KIND (node) = OMP_CLAUSE_DEPEND_IN;
    3016                 :         224 :                     break;
    3017                 :         256 :                   case OMP_DEPEND_OUT:
    3018                 :         256 :                     OMP_CLAUSE_DEPEND_KIND (node) = OMP_CLAUSE_DEPEND_OUT;
    3019                 :         256 :                     break;
    3020                 :          49 :                   case OMP_DEPEND_INOUT:
    3021                 :          49 :                     OMP_CLAUSE_DEPEND_KIND (node) = OMP_CLAUSE_DEPEND_INOUT;
    3022                 :          49 :                     break;
    3023                 :           9 :                   case OMP_DEPEND_INOUTSET:
    3024                 :           9 :                     OMP_CLAUSE_DEPEND_KIND (node) = OMP_CLAUSE_DEPEND_INOUTSET;
    3025                 :           9 :                     break;
    3026                 :          15 :                   case OMP_DEPEND_MUTEXINOUTSET:
    3027                 :          15 :                     OMP_CLAUSE_DEPEND_KIND (node)
    3028                 :          15 :                       = OMP_CLAUSE_DEPEND_MUTEXINOUTSET;
    3029                 :          15 :                     break;
    3030                 :          35 :                   case OMP_DEPEND_DEPOBJ:
    3031                 :          35 :                     OMP_CLAUSE_DEPEND_KIND (node) = OMP_CLAUSE_DEPEND_DEPOBJ;
    3032                 :          35 :                     break;
    3033                 :           0 :                   default:
    3034                 :           0 :                     gcc_unreachable ();
    3035                 :             :                   }
    3036                 :         614 :               if (!iterator)
    3037                 :         562 :                 gfc_add_block_to_block (block, &iter_block);
    3038                 :         614 :               omp_clauses = gfc_trans_add_clause (node, omp_clauses);
    3039                 :             :             }
    3040                 :         713 :           if (iterator)
    3041                 :             :             { 
    3042                 :          31 :               BLOCK_SUBBLOCKS (tree_block) = gfc_finish_block (&iter_block);
    3043                 :          31 :               TREE_VEC_ELT (iterator, 5) = tree_block;
    3044                 :          70 :               for (tree c = omp_clauses; c != prev_clauses;
    3045                 :          39 :                    c = OMP_CLAUSE_CHAIN (c))
    3046                 :          78 :                 OMP_CLAUSE_DECL (c) = build_tree_list (iterator,
    3047                 :          39 :                                                        OMP_CLAUSE_DECL (c));
    3048                 :             :             }
    3049                 :             :           break;
    3050                 :             :         case OMP_LIST_MAP:
    3051                 :       20487 :           for (; n != NULL; n = n->next)
    3052                 :             :             {
    3053                 :       12794 :               if (!n->sym->attr.referenced)
    3054                 :           0 :                 continue;
    3055                 :             : 
    3056                 :       12794 :               bool always_modifier = false;
    3057                 :       12794 :               tree node = build_omp_clause (input_location, OMP_CLAUSE_MAP);
    3058                 :       12794 :               tree node2 = NULL_TREE;
    3059                 :       12794 :               tree node3 = NULL_TREE;
    3060                 :       12794 :               tree node4 = NULL_TREE;
    3061                 :       12794 :               tree node5 = NULL_TREE;
    3062                 :             : 
    3063                 :             :               /* OpenMP: automatically map pointer targets with the pointer;
    3064                 :             :                  hence, always update the descriptor/pointer itself.  */
    3065                 :       12794 :               if (!openacc
    3066                 :       12794 :                   && ((n->expr == NULL && n->sym->attr.pointer)
    3067                 :       12025 :                       || (n->expr && gfc_expr_attr (n->expr).pointer)))
    3068                 :         901 :                 always_modifier = true;
    3069                 :             : 
    3070                 :       12794 :               switch (n->u.map_op)
    3071                 :             :                 {
    3072                 :         985 :                 case OMP_MAP_ALLOC:
    3073                 :         985 :                   OMP_CLAUSE_SET_MAP_KIND (node, GOMP_MAP_ALLOC);
    3074                 :         985 :                   break;
    3075                 :          63 :                 case OMP_MAP_IF_PRESENT:
    3076                 :          63 :                   OMP_CLAUSE_SET_MAP_KIND (node, GOMP_MAP_IF_PRESENT);
    3077                 :          63 :                   break;
    3078                 :          62 :                 case OMP_MAP_ATTACH:
    3079                 :          62 :                   OMP_CLAUSE_SET_MAP_KIND (node, GOMP_MAP_ATTACH);
    3080                 :          62 :                   break;
    3081                 :        3372 :                 case OMP_MAP_TO:
    3082                 :        3372 :                   OMP_CLAUSE_SET_MAP_KIND (node, GOMP_MAP_TO);
    3083                 :        3372 :                   break;
    3084                 :        2528 :                 case OMP_MAP_FROM:
    3085                 :        2528 :                   OMP_CLAUSE_SET_MAP_KIND (node, GOMP_MAP_FROM);
    3086                 :        2528 :                   break;
    3087                 :        3688 :                 case OMP_MAP_TOFROM:
    3088                 :        3688 :                   OMP_CLAUSE_SET_MAP_KIND (node, GOMP_MAP_TOFROM);
    3089                 :        3688 :                   break;
    3090                 :          32 :                 case OMP_MAP_ALWAYS_TO:
    3091                 :          32 :                   always_modifier = true;
    3092                 :          32 :                   OMP_CLAUSE_SET_MAP_KIND (node, GOMP_MAP_ALWAYS_TO);
    3093                 :          32 :                   break;
    3094                 :          14 :                 case OMP_MAP_ALWAYS_FROM:
    3095                 :          14 :                   always_modifier = true;
    3096                 :          14 :                   OMP_CLAUSE_SET_MAP_KIND (node, GOMP_MAP_ALWAYS_FROM);
    3097                 :          14 :                   break;
    3098                 :         145 :                 case OMP_MAP_ALWAYS_TOFROM:
    3099                 :         145 :                   always_modifier = true;
    3100                 :         145 :                   OMP_CLAUSE_SET_MAP_KIND (node, GOMP_MAP_ALWAYS_TOFROM);
    3101                 :         145 :                   break;
    3102                 :           6 :                 case OMP_MAP_PRESENT_ALLOC:
    3103                 :           6 :                   OMP_CLAUSE_SET_MAP_KIND (node, GOMP_MAP_PRESENT_ALLOC);
    3104                 :           6 :                   break;
    3105                 :          13 :                 case OMP_MAP_PRESENT_TO:
    3106                 :          13 :                   OMP_CLAUSE_SET_MAP_KIND (node, GOMP_MAP_PRESENT_TO);
    3107                 :          13 :                   break;
    3108                 :           4 :                 case OMP_MAP_PRESENT_FROM:
    3109                 :           4 :                   OMP_CLAUSE_SET_MAP_KIND (node, GOMP_MAP_PRESENT_FROM);
    3110                 :           4 :                   break;
    3111                 :           2 :                 case OMP_MAP_PRESENT_TOFROM:
    3112                 :           2 :                   OMP_CLAUSE_SET_MAP_KIND (node, GOMP_MAP_PRESENT_TOFROM);
    3113                 :           2 :                   break;
    3114                 :           8 :                 case OMP_MAP_ALWAYS_PRESENT_TO:
    3115                 :           8 :                   always_modifier = true;
    3116                 :           8 :                   OMP_CLAUSE_SET_MAP_KIND (node, GOMP_MAP_ALWAYS_PRESENT_TO);
    3117                 :           8 :                   break;
    3118                 :           4 :                 case OMP_MAP_ALWAYS_PRESENT_FROM:
    3119                 :           4 :                   always_modifier = true;
    3120                 :           4 :                   OMP_CLAUSE_SET_MAP_KIND (node, GOMP_MAP_ALWAYS_PRESENT_FROM);
    3121                 :           4 :                   break;
    3122                 :           2 :                 case OMP_MAP_ALWAYS_PRESENT_TOFROM:
    3123                 :           2 :                   always_modifier = true;
    3124                 :           2 :                   OMP_CLAUSE_SET_MAP_KIND (node, GOMP_MAP_ALWAYS_PRESENT_TOFROM);
    3125                 :           2 :                   break;
    3126                 :         304 :                 case OMP_MAP_RELEASE:
    3127                 :         304 :                   OMP_CLAUSE_SET_MAP_KIND (node, GOMP_MAP_RELEASE);
    3128                 :         304 :                   break;
    3129                 :          53 :                 case OMP_MAP_DELETE:
    3130                 :          53 :                   OMP_CLAUSE_SET_MAP_KIND (node, GOMP_MAP_DELETE);
    3131                 :          53 :                   break;
    3132                 :          40 :                 case OMP_MAP_DETACH:
    3133                 :          40 :                   OMP_CLAUSE_SET_MAP_KIND (node, GOMP_MAP_DETACH);
    3134                 :          40 :                   break;
    3135                 :          62 :                 case OMP_MAP_FORCE_ALLOC:
    3136                 :          62 :                   OMP_CLAUSE_SET_MAP_KIND (node, GOMP_MAP_FORCE_ALLOC);
    3137                 :          62 :                   break;
    3138                 :         393 :                 case OMP_MAP_FORCE_TO:
    3139                 :         393 :                   OMP_CLAUSE_SET_MAP_KIND (node, GOMP_MAP_FORCE_TO);
    3140                 :         393 :                   break;
    3141                 :         505 :                 case OMP_MAP_FORCE_FROM:
    3142                 :         505 :                   OMP_CLAUSE_SET_MAP_KIND (node, GOMP_MAP_FORCE_FROM);
    3143                 :         505 :                   break;
    3144                 :           0 :                 case OMP_MAP_FORCE_TOFROM:
    3145                 :           0 :                   OMP_CLAUSE_SET_MAP_KIND (node, GOMP_MAP_FORCE_TOFROM);
    3146                 :           0 :                   break;
    3147                 :         506 :                 case OMP_MAP_FORCE_PRESENT:
    3148                 :         506 :                   OMP_CLAUSE_SET_MAP_KIND (node, GOMP_MAP_FORCE_PRESENT);
    3149                 :         506 :                   break;
    3150                 :           3 :                 case OMP_MAP_FORCE_DEVICEPTR:
    3151                 :           3 :                   OMP_CLAUSE_SET_MAP_KIND (node, GOMP_MAP_FORCE_DEVICEPTR);
    3152                 :           3 :                   break;
    3153                 :           0 :                 default:
    3154                 :           0 :                   gcc_unreachable ();
    3155                 :             :                 }
    3156                 :             : 
    3157                 :       12794 :               tree decl = gfc_trans_omp_variable (n->sym, false);
    3158                 :       12794 :               if (DECL_P (decl))
    3159                 :       12794 :                 TREE_ADDRESSABLE (decl) = 1;
    3160                 :             : 
    3161                 :       12794 :               gfc_ref *lastref = NULL;
    3162                 :             : 
    3163                 :       12794 :               if (n->expr)
    3164                 :        8523 :                 for (gfc_ref *ref = n->expr->ref; ref; ref = ref->next)
    3165                 :        4806 :                   if (ref->type == REF_COMPONENT || ref->type == REF_ARRAY)
    3166                 :        4806 :                     lastref = ref;
    3167                 :             : 
    3168                 :        3717 :               bool allocatable = false, pointer = false;
    3169                 :             : 
    3170                 :        3717 :               if (lastref && lastref->type == REF_COMPONENT)
    3171                 :             :                 {
    3172                 :         401 :                   gfc_component *c = lastref->u.c.component;
    3173                 :             : 
    3174                 :         401 :                   if (c->ts.type == BT_CLASS)
    3175                 :             :                     {
    3176                 :          24 :                       pointer = CLASS_DATA (c)->attr.class_pointer;
    3177                 :          24 :                       allocatable = CLASS_DATA (c)->attr.allocatable;
    3178                 :             :                     }
    3179                 :             :                   else
    3180                 :             :                     {
    3181                 :         377 :                       pointer = c->attr.pointer;
    3182                 :         377 :                       allocatable = c->attr.allocatable;
    3183                 :             :                     }
    3184                 :             :                 }
    3185                 :             : 
    3186                 :       12794 :               if (n->expr == NULL
    3187                 :        3717 :                   || (n->expr->ref->type == REF_ARRAY
    3188                 :        2691 :                       && n->expr->ref->u.ar.type == AR_FULL))
    3189                 :             :                 {
    3190                 :        9077 :                   gomp_map_kind map_kind;
    3191                 :        9077 :                   tree type = TREE_TYPE (decl);
    3192                 :        9077 :                   if (n->sym->ts.type == BT_CHARACTER
    3193                 :         182 :                       && n->sym->ts.deferred
    3194                 :          68 :                       && n->sym->attr.omp_declare_target
    3195                 :           8 :                       && (always_modifier || n->sym->attr.pointer)
    3196                 :           8 :                       && op != EXEC_OMP_TARGET_EXIT_DATA
    3197                 :           4 :                       && n->u.map_op != OMP_MAP_DELETE
    3198                 :           4 :                       && n->u.map_op != OMP_MAP_RELEASE)
    3199                 :             :                     {
    3200                 :           4 :                       gcc_assert (n->sym->ts.u.cl->backend_decl);
    3201                 :           4 :                       node5 = build_omp_clause (input_location, OMP_CLAUSE_MAP);
    3202                 :           4 :                       OMP_CLAUSE_SET_MAP_KIND (node5, GOMP_MAP_ALWAYS_TO);
    3203                 :           4 :                       OMP_CLAUSE_DECL (node5) = n->sym->ts.u.cl->backend_decl;
    3204                 :           4 :                       OMP_CLAUSE_SIZE (node5)
    3205                 :           8 :                         = TYPE_SIZE_UNIT (gfc_charlen_type_node);
    3206                 :             :                     }
    3207                 :             : 
    3208                 :        9077 :                   tree present = gfc_omp_check_optional_argument (decl, true);
    3209                 :        9077 :                   if (openacc && n->sym->ts.type == BT_CLASS)
    3210                 :             :                     {
    3211                 :          60 :                       if (n->sym->attr.optional)
    3212                 :           0 :                         sorry ("optional class parameter");
    3213                 :          60 :                       tree ptr = gfc_class_data_get (decl);
    3214                 :          60 :                       ptr = build_fold_indirect_ref (ptr);
    3215                 :          60 :                       OMP_CLAUSE_DECL (node) = ptr;
    3216                 :          60 :                       OMP_CLAUSE_SIZE (node) = gfc_class_vtab_size_get (decl);
    3217                 :          60 :                       node2 = build_omp_clause (input_location, OMP_CLAUSE_MAP);
    3218                 :          60 :                       OMP_CLAUSE_SET_MAP_KIND (node2, GOMP_MAP_ATTACH_DETACH);
    3219                 :          60 :                       OMP_CLAUSE_DECL (node2) = gfc_class_data_get (decl);
    3220                 :          60 :                       OMP_CLAUSE_SIZE (node2) = size_int (0);
    3221                 :          60 :                       goto finalize_map_clause;
    3222                 :             :                     }
    3223                 :        9017 :                   else if (POINTER_TYPE_P (type)
    3224                 :        9017 :                            && (gfc_omp_privatize_by_reference (decl)
    3225                 :         401 :                                || GFC_DECL_GET_SCALAR_POINTER (decl)
    3226                 :         239 :                                || GFC_DECL_GET_SCALAR_ALLOCATABLE (decl)
    3227                 :          60 :                                || GFC_DECL_CRAY_POINTEE (decl)
    3228                 :          60 :                                || GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (type))
    3229                 :          60 :                                || (n->sym->ts.type == BT_DERIVED
    3230                 :           8 :                                    && (n->sym->ts.u.derived->ts.f90_type
    3231                 :             :                                        != BT_VOID))))
    3232                 :             :                     {
    3233                 :        3246 :                       tree orig_decl = decl;
    3234                 :             : 
    3235                 :             :                       /* For nonallocatable, nonpointer arrays, a temporary
    3236                 :             :                          variable is generated, but this one is only defined if
    3237                 :             :                          the variable is present; hence, we now set it to NULL
    3238                 :             :                          to avoid accessing undefined variables.  We cannot use
    3239                 :             :                          a temporary variable here as otherwise the replacement
    3240                 :             :                          of the variables in omp-low.cc will not work.  */
    3241                 :        3246 :                       if (present && GFC_ARRAY_TYPE_P (type))
    3242                 :             :                         {
    3243                 :         283 :                           tree tmp = fold_build2_loc (input_location,
    3244                 :             :                                                       MODIFY_EXPR,
    3245                 :             :                                                       void_type_node, decl,
    3246                 :             :                                                       null_pointer_node);
    3247                 :         283 :                           tree cond = fold_build1_loc (input_location,
    3248                 :             :                                                        TRUTH_NOT_EXPR,
    3249                 :             :                                                        boolean_type_node,
    3250                 :             :                                                        present);
    3251                 :         283 :                           gfc_add_expr_to_block (block,
    3252                 :             :                                                  build3_loc (input_location,
    3253                 :             :                                                              COND_EXPR,
    3254                 :             :                                                              void_type_node,
    3255                 :             :                                                              cond, tmp,
    3256                 :             :                                                              NULL_TREE));
    3257                 :             :                         }
    3258                 :             :                       /* For descriptor types, the unmapping happens below.  */
    3259                 :        3246 :                       if (op != EXEC_OMP_TARGET_EXIT_DATA
    3260                 :        3246 :                           || !GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (decl)))
    3261                 :             :                         {
    3262                 :        3246 :                           enum gomp_map_kind gmk = GOMP_MAP_POINTER;
    3263                 :        3246 :                           if (op == EXEC_OMP_TARGET_EXIT_DATA
    3264                 :          32 :                               && n->u.map_op == OMP_MAP_DELETE)
    3265                 :             :                             gmk = GOMP_MAP_DELETE;
    3266                 :          27 :                           else if (op == EXEC_OMP_TARGET_EXIT_DATA)
    3267                 :          27 :                             gmk = GOMP_MAP_RELEASE;
    3268                 :        3246 :                           tree size;
    3269                 :        3246 :                           if (gmk == GOMP_MAP_RELEASE || gmk == GOMP_MAP_DELETE)
    3270                 :          32 :                             size = TYPE_SIZE_UNIT (TREE_TYPE (decl));
    3271                 :             :                           else
    3272                 :        3214 :                             size = size_int (0);
    3273                 :        3246 :                           node4 = build_omp_clause (input_location,
    3274                 :             :                                                     OMP_CLAUSE_MAP);
    3275                 :        3246 :                           OMP_CLAUSE_SET_MAP_KIND (node4, gmk);
    3276                 :        3246 :                           OMP_CLAUSE_DECL (node4) = decl;
    3277                 :        3246 :                           OMP_CLAUSE_SIZE (node4) = size;
    3278                 :             :                         }
    3279                 :        3246 :                       decl = build_fold_indirect_ref (decl);
    3280                 :        3246 :                       if ((TREE_CODE (TREE_TYPE (orig_decl)) == REFERENCE_TYPE
    3281                 :        2031 :                            || gfc_omp_is_optional_argument (orig_decl))
    3282                 :        4294 :                           && (GFC_DECL_GET_SCALAR_POINTER (orig_decl)
    3283                 :        2093 :                               || GFC_DECL_GET_SCALAR_ALLOCATABLE (orig_decl)))
    3284                 :             :                         {
    3285                 :         406 :                           enum gomp_map_kind gmk;
    3286                 :         406 :                           if (op == EXEC_OMP_TARGET_EXIT_DATA
    3287                 :           8 :                               && n->u.map_op == OMP_MAP_DELETE)
    3288                 :             :                             gmk = GOMP_MAP_DELETE;
    3289                 :           6 :                           else if (op == EXEC_OMP_TARGET_EXIT_DATA)
    3290                 :             :                             gmk = GOMP_MAP_RELEASE;
    3291                 :             :                           else
    3292                 :             :                             gmk = GOMP_MAP_POINTER;
    3293                 :         406 :                           tree size;
    3294                 :         406 :                           if (gmk == GOMP_MAP_RELEASE || gmk == GOMP_MAP_DELETE)
    3295                 :           8 :                             size = TYPE_SIZE_UNIT (TREE_TYPE (decl));
    3296                 :             :                           else
    3297                 :         398 :                             size = size_int (0);
    3298                 :         406 :                           node3 = build_omp_clause (input_location,
    3299                 :             :                                                     OMP_CLAUSE_MAP);
    3300                 :         406 :                           OMP_CLAUSE_SET_MAP_KIND (node3, gmk);
    3301                 :         406 :                           OMP_CLAUSE_DECL (node3) = decl;
    3302                 :         406 :                           OMP_CLAUSE_SIZE (node3) = size;
    3303                 :         406 :                           decl = build_fold_indirect_ref (decl);
    3304                 :             :                         }
    3305                 :             :                     }
    3306                 :        9017 :                   if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (decl)))
    3307                 :             :                     {
    3308                 :        1358 :                       tree type = TREE_TYPE (decl);
    3309                 :        1358 :                       tree ptr = gfc_conv_descriptor_data_get (decl);
    3310                 :        1358 :                       if (present)
    3311                 :         308 :                         ptr = gfc_build_cond_assign_expr (block, present, ptr,
    3312                 :             :                                                           null_pointer_node);
    3313                 :        1358 :                       gcc_assert (POINTER_TYPE_P (TREE_TYPE (ptr)));
    3314                 :        1358 :                       ptr = build_fold_indirect_ref (ptr);
    3315                 :        1358 :                       OMP_CLAUSE_DECL (node) = ptr;
    3316                 :        1358 :                       node2 = build_omp_clause (input_location, OMP_CLAUSE_MAP);
    3317                 :        1358 :                       OMP_CLAUSE_DECL (node2) = decl;
    3318                 :        1358 :                       OMP_CLAUSE_SIZE (node2) = TYPE_SIZE_UNIT (type);
    3319                 :        1358 :                       if (n->u.map_op == OMP_MAP_DELETE)
    3320                 :             :                         map_kind = GOMP_MAP_DELETE;
    3321                 :        1331 :                       else if (op == EXEC_OMP_TARGET_EXIT_DATA
    3322                 :        1276 :                                || n->u.map_op == OMP_MAP_RELEASE)
    3323                 :             :                         map_kind = GOMP_MAP_RELEASE;
    3324                 :             :                       else
    3325                 :        1358 :                         map_kind = GOMP_MAP_TO_PSET;
    3326                 :        1358 :                       OMP_CLAUSE_SET_MAP_KIND (node2, map_kind);
    3327                 :             : 
    3328                 :        1358 :                       if (op != EXEC_OMP_TARGET_EXIT_DATA
    3329                 :        1276 :                           && n->u.map_op != OMP_MAP_DELETE
    3330                 :        1276 :                           && n->u.map_op != OMP_MAP_RELEASE)
    3331                 :             :                         {
    3332                 :        1234 :                           node3 = build_omp_clause (input_location,
    3333                 :             :                                                     OMP_CLAUSE_MAP);
    3334                 :        1234 :                           if (present)
    3335                 :             :                             {
    3336                 :         308 :                               ptr = gfc_conv_descriptor_data_get (decl);
    3337                 :         308 :                               ptr = gfc_build_addr_expr (NULL, ptr);
    3338                 :         308 :                               ptr = gfc_build_cond_assign_expr (
    3339                 :             :                                       block, present, ptr, null_pointer_node);
    3340                 :         308 :                               ptr = build_fold_indirect_ref (ptr);
    3341                 :         308 :                               OMP_CLAUSE_DECL (node3) = ptr;
    3342                 :             :                             }
    3343                 :             :                           else
    3344                 :         926 :                             OMP_CLAUSE_DECL (node3)
    3345                 :        1852 :                               = gfc_conv_descriptor_data_get (decl);
    3346                 :        1234 :                           OMP_CLAUSE_SIZE (node3) = size_int (0);
    3347                 :             : 
    3348                 :        1234 :                           if (n->u.map_op == OMP_MAP_ATTACH)
    3349                 :             :                             {
    3350                 :             :                               /* Standalone attach clauses used with arrays with
    3351                 :             :                                  descriptors must copy the descriptor to the
    3352                 :             :                                  target, else they won't have anything to
    3353                 :             :                                  perform the attachment onto (see OpenACC 2.6,
    3354                 :             :                                  "2.6.3. Data Structures with Pointers").  */
    3355                 :           7 :                               OMP_CLAUSE_SET_MAP_KIND (node3, GOMP_MAP_ATTACH);
    3356                 :             :                               /* We don't want to map PTR at all in this case,
    3357                 :             :                                  so delete its node and shuffle the others
    3358                 :             :                                  down.  */
    3359                 :           7 :                               node = node2;
    3360                 :           7 :                               node2 = node3;
    3361                 :           7 :                               node3 = NULL;
    3362                 :           7 :                               goto finalize_map_clause;
    3363                 :             :                             }
    3364                 :        1227 :                           else if (n->u.map_op == OMP_MAP_DETACH)
    3365                 :             :                             {
    3366                 :           2 :                               OMP_CLAUSE_SET_MAP_KIND (node3, GOMP_MAP_DETACH);
    3367                 :             :                               /* Similarly to above, we don't want to unmap PTR
    3368                 :             :                                  here.  */
    3369                 :           2 :                               node = node2;
    3370                 :           2 :                               node2 = node3;
    3371                 :           2 :                               node3 = NULL;
    3372                 :           2 :                               goto finalize_map_clause;
    3373                 :             :                             }
    3374                 :             :                           else
    3375                 :        1989 :                             OMP_CLAUSE_SET_MAP_KIND (node3,
    3376                 :             :                                                      always_modifier
    3377                 :             :                                                      ? GOMP_MAP_ALWAYS_POINTER
    3378                 :             :                                                      : GOMP_MAP_POINTER);
    3379                 :             :                         }
    3380                 :             : 
    3381                 :             :                       /* We have to check for n->sym->attr.dimension because
    3382                 :             :                          of scalar coarrays.  */
    3383                 :        1349 :                       if ((n->sym->attr.pointer || n->sym->attr.allocatable)
    3384                 :        1349 :                           && n->sym->attr.dimension)
    3385                 :             :                         {
    3386                 :        1349 :                           stmtblock_t cond_block;
    3387                 :        1349 :                           tree size
    3388                 :        1349 :                             = gfc_create_var (gfc_array_index_type, NULL);
    3389                 :        1349 :                           tree tem, then_b, else_b, zero, cond;
    3390                 :             : 
    3391                 :        1349 :                           gfc_init_block (&cond_block);
    3392                 :        1349 :                           tem
    3393                 :        2698 :                             = gfc_full_array_size (&cond_block, decl,
    3394                 :        1349 :                                                    GFC_TYPE_ARRAY_RANK (type));
    3395                 :        1349 :                           tree elemsz;
    3396                 :        1349 :                           if (n->sym->ts.type == BT_CHARACTER
    3397                 :          40 :                               && n->sym->ts.deferred)
    3398                 :             :                             {
    3399                 :          32 :                               tree len = n->sym->ts.u.cl->backend_decl;
    3400                 :          32 :                               len = fold_convert (size_type_node, len);
    3401                 :          32 :                               elemsz = gfc_get_char_type (n->sym->ts.kind);
    3402                 :          32 :                               elemsz = TYPE_SIZE_UNIT (elemsz);
    3403                 :          32 :                               elemsz = fold_build2 (MULT_EXPR, size_type_node,
    3404                 :             :                                                     len, elemsz);
    3405                 :          32 :                             }
    3406                 :             :                           else
    3407                 :        1317 :                             elemsz
    3408                 :        1317 :                               = TYPE_SIZE_UNIT (gfc_get_element_type (type));
    3409                 :        1349 :                           elemsz = fold_convert (gfc_array_index_type, elemsz);
    3410                 :        1349 :                           tem = fold_build2 (MULT_EXPR, gfc_array_index_type,
    3411                 :             :                                              tem, elemsz);
    3412                 :        1349 :                           gfc_add_modify (&cond_block, size, tem);
    3413                 :        1349 :                           then_b = gfc_finish_block (&cond_block);
    3414                 :        1349 :                           gfc_init_block (&cond_block);
    3415                 :        1349 :                           zero = build_int_cst (gfc_array_index_type, 0);
    3416                 :        1349 :                           gfc_add_modify (&cond_block, size, zero);
    3417                 :        1349 :                           else_b = gfc_finish_block (&cond_block);
    3418                 :        1349 :                           tem = gfc_conv_descriptor_data_get (decl);
    3419                 :        1349 :                           tem = fold_convert (pvoid_type_node, tem);
    3420                 :        1349 :                           cond = fold_build2_loc (input_location, NE_EXPR,
    3421                 :             :                                                   boolean_type_node,
    3422                 :             :                                                   tem, null_pointer_node);
    3423                 :        1349 :                           if (present)
    3424                 :         308 :                             cond = fold_build2_loc (input_location,
    3425                 :             :                                                     TRUTH_ANDIF_EXPR,
    3426                 :             :                                                     boolean_type_node,
    3427                 :             :                                                     present, cond);
    3428                 :        1349 :                           gfc_add_expr_to_block (block,
    3429                 :             :                                                  build3_loc (input_location,
    3430                 :             :                                                              COND_EXPR,
    3431                 :             :                                                              void_type_node,
    3432                 :             :                                                              cond, then_b,
    3433                 :             :                                                              else_b));
    3434                 :        1349 :                           OMP_CLAUSE_SIZE (node) = size;
    3435                 :        1349 :                         }
    3436                 :           0 :                       else if (n->sym->attr.dimension)
    3437                 :             :                         {
    3438                 :           0 :                           stmtblock_t cond_block;
    3439                 :           0 :                           gfc_init_block (&cond_block);
    3440                 :           0 :                           tree size = gfc_full_array_size (&cond_block, decl,
    3441                 :           0 :                                         GFC_TYPE_ARRAY_RANK (type));
    3442                 :           0 :                           tree elemsz
    3443                 :           0 :                             = TYPE_SIZE_UNIT (gfc_get_element_type (type));
    3444                 :           0 :                           elemsz = fold_convert (gfc_array_index_type, elemsz);
    3445                 :           0 :                           size = fold_build2 (MULT_EXPR, gfc_array_index_type,
    3446                 :             :                                               size, elemsz);
    3447                 :           0 :                           size = gfc_evaluate_now (size, &cond_block);
    3448                 :           0 :                           if (present)
    3449                 :             :                             {
    3450                 :           0 :                               tree var = gfc_create_var (gfc_array_index_type,
    3451                 :             :                                                          NULL);
    3452                 :           0 :                               gfc_add_modify (&cond_block, var, size);
    3453                 :           0 :                               tree cond_body = gfc_finish_block (&cond_block);
    3454                 :           0 :                               tree cond = build3_loc (input_location, COND_EXPR,
    3455                 :             :                                                       void_type_node, present,
    3456                 :             :                                                       cond_body, NULL_TREE);
    3457                 :           0 :                               gfc_add_expr_to_block (block, cond);
    3458                 :           0 :                               OMP_CLAUSE_SIZE (node) = var;
    3459                 :             :                             }
    3460                 :             :                           else
    3461                 :             :                             {
    3462                 :           0 :                               gfc_add_block_to_block (block, &cond_block);
    3463                 :           0 :                               OMP_CLAUSE_SIZE (node) = size;
    3464                 :             :                             }
    3465                 :             :                         }
    3466                 :             :                     }
    3467                 :        7659 :                   else if (present
    3468                 :         842 :                            && INDIRECT_REF_P (decl)
    3469                 :        8399 :                            && INDIRECT_REF_P (TREE_OPERAND (decl, 0)))
    3470                 :             :                     {
    3471                 :             :                       /* A single indirectref is handled by the middle end.  */
    3472                 :         227 :                       gcc_assert (!POINTER_TYPE_P (TREE_TYPE (decl)));
    3473                 :         227 :                       decl = TREE_OPERAND (decl, 0);
    3474                 :         227 :                       decl = gfc_build_cond_assign_expr (block, present, decl,
    3475                 :             :                                                          null_pointer_node);
    3476                 :         227 :                       OMP_CLAUSE_DECL (node) = build_fold_indirect_ref (decl);
    3477                 :             :                     }
    3478                 :             :                   else
    3479                 :        7432 :                     OMP_CLAUSE_DECL (node) = decl;
    3480                 :             : 
    3481                 :        9008 :                   if (!n->sym->attr.dimension
    3482                 :        5681 :                       && n->sym->ts.type == BT_CHARACTER
    3483                 :         126 :                       && n->sym->ts.deferred)
    3484                 :             :                     {
    3485                 :          36 :                       if (!DECL_P (decl))
    3486                 :             :                         {
    3487                 :          34 :                           gcc_assert (TREE_CODE (decl) == INDIRECT_REF);
    3488                 :          34 :                           decl = TREE_OPERAND (decl, 0);
    3489                 :             :                         }
    3490                 :          36 :                       tree cond = fold_build2_loc (input_location, NE_EXPR,
    3491                 :             :                                                    boolean_type_node,
    3492                 :             :                                                    decl, null_pointer_node);
    3493                 :          36 :                       if (present)
    3494                 :           2 :                         cond = fold_build2_loc (input_location,
    3495                 :             :                                                 TRUTH_ANDIF_EXPR,
    3496                 :             :                                                 boolean_type_node,
    3497                 :             :                                                 present, cond);
    3498                 :          36 :                       tree len = n->sym->ts.u.cl->backend_decl;
    3499                 :          36 :                       len = fold_convert (size_type_node, len);
    3500                 :          36 :                       tree size = gfc_get_char_type (n->sym->ts.kind);
    3501                 :          36 :                       size = TYPE_SIZE_UNIT (size);
    3502                 :          36 :                       size = fold_build2 (MULT_EXPR, size_type_node, len, size);
    3503                 :          36 :                       size = build3_loc (input_location,
    3504                 :             :                                                          COND_EXPR,
    3505                 :             :                                                          size_type_node,
    3506                 :             :                                                          cond, size,
    3507                 :             :                                                          size_zero_node);
    3508                 :          36 :                       size = gfc_evaluate_now (size, block);
    3509                 :          36 :                       OMP_CLAUSE_SIZE (node) = size;
    3510                 :             :                     }
    3511                 :             :                 }
    3512                 :        3717 :               else if (n->expr
    3513                 :        3717 :                        && n->expr->expr_type == EXPR_VARIABLE
    3514                 :        3717 :                        && n->expr->ref->type == REF_ARRAY
    3515                 :        2691 :                        && !n->expr->ref->next)
    3516                 :             :                 {
    3517                 :             :                   /* An array element or array section which is not part of a
    3518                 :             :                      derived type, etc.  */
    3519                 :        2628 :                   bool element = n->expr->ref->u.ar.type == AR_ELEMENT;
    3520                 :        2628 :                   tree type = TREE_TYPE (decl);
    3521                 :        2628 :                   gomp_map_kind k = GOMP_MAP_POINTER;
    3522                 :        2628 :                   if (!openacc
    3523                 :         411 :                       && !GFC_DESCRIPTOR_TYPE_P (type)
    3524                 :        2991 :                       && !(POINTER_TYPE_P (type)
    3525                 :         241 :                            && GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (type))))
    3526                 :             :                     k = GOMP_MAP_FIRSTPRIVATE_POINTER;
    3527                 :        2628 :                   gfc_trans_omp_array_section (block, op, n, decl, element, k,
    3528                 :             :                                                node, node2, node3, node4);
    3529                 :        2628 :                 }
    3530                 :        1089 :               else if (n->expr
    3531                 :        1089 :                        && n->expr->expr_type == EXPR_VARIABLE
    3532                 :        1089 :                        && (n->expr->ref->type == REF_COMPONENT
    3533                 :             :                            || n->expr->ref->type == REF_ARRAY)
    3534                 :        1089 :                        && lastref
    3535                 :        1089 :                        && lastref->type == REF_COMPONENT
    3536                 :         401 :                        && lastref->u.c.component->ts.type != BT_CLASS
    3537                 :         377 :                        && lastref->u.c.component->ts.type != BT_DERIVED
    3538                 :         305 :                        && !lastref->u.c.component->attr.dimension)
    3539                 :             :                 {
    3540                 :             :                   /* Derived type access with last component being a scalar.  */
    3541                 :         305 :                   gfc_init_se (&se, NULL);
    3542                 :             : 
    3543                 :         305 :                   gfc_conv_expr (&se, n->expr);
    3544                 :         305 :                   gfc_add_block_to_block (block, &se.pre);
    3545                 :             :                   /* For BT_CHARACTER a pointer is returned.  */
    3546                 :         305 :                   OMP_CLAUSE_DECL (node)
    3547                 :         522 :                     = POINTER_TYPE_P (TREE_TYPE (se.expr))
    3548                 :         305 :                       ? build_fold_indirect_ref (se.expr) : se.expr;
    3549                 :         305 :                   gfc_add_block_to_block (block, &se.post);
    3550                 :         305 :                   if (pointer || allocatable)
    3551                 :             :                     {
    3552                 :             :                       /* If it's a bare attach/detach clause, we just want
    3553                 :             :                          to perform a single attach/detach operation, of the
    3554                 :             :                          pointer itself, not of the pointed-to object.  */
    3555                 :         140 :                       if (openacc
    3556                 :          68 :                           && (n->u.map_op == OMP_MAP_ATTACH
    3557                 :          50 :                               || n->u.map_op == OMP_MAP_DETACH))
    3558                 :             :                         {
    3559                 :          36 :                           OMP_CLAUSE_DECL (node)
    3560                 :          36 :                             = build_fold_addr_expr (OMP_CLAUSE_DECL (node));
    3561                 :          36 :                           OMP_CLAUSE_SIZE (node) = size_zero_node;
    3562                 :          36 :                           goto finalize_map_clause;
    3563                 :             :                         }
    3564                 :             : 
    3565                 :         104 :                       node2 = build_omp_clause (input_location,
    3566                 :             :                                                 OMP_CLAUSE_MAP);
    3567                 :         208 :                       gomp_map_kind kind
    3568                 :         104 :                         = (openacc ? GOMP_MAP_ATTACH_DETACH
    3569                 :             :                                    : GOMP_MAP_ALWAYS_POINTER);
    3570                 :         104 :                       OMP_CLAUSE_SET_MAP_KIND (node2, kind);
    3571                 :         104 :                       OMP_CLAUSE_DECL (node2)
    3572                 :         144 :                         = POINTER_TYPE_P (TREE_TYPE (se.expr))
    3573                 :         104 :                           ? se.expr
    3574                 :          40 :                           : gfc_build_addr_expr (NULL, se.expr);
    3575                 :         104 :                       OMP_CLAUSE_SIZE (node2) = size_int (0);
    3576                 :         104 :                       if (!openacc
    3577                 :          72 :                           && n->expr->ts.type == BT_CHARACTER
    3578                 :          48 :                           && n->expr->ts.deferred)
    3579                 :             :                         {
    3580                 :          48 :                           gcc_assert (se.string_length);
    3581                 :          48 :                           tree tmp
    3582                 :          48 :                             = gfc_get_char_type (n->expr->ts.kind);
    3583                 :          48 :                           OMP_CLAUSE_SIZE (node)
    3584                 :          48 :                             = fold_build2 (MULT_EXPR, size_type_node,
    3585                 :             :                                            fold_convert (size_type_node,
    3586                 :             :                                                se.string_length),
    3587                 :             :                                            TYPE_SIZE_UNIT (tmp));
    3588                 :          48 :                           if (n->u.map_op == OMP_MAP_DELETE)
    3589                 :             :                             kind = GOMP_MAP_DELETE;
    3590                 :          48 :                           else if (op == EXEC_OMP_TARGET_EXIT_DATA)
    3591                 :             :                             kind = GOMP_MAP_RELEASE;
    3592                 :             :                           else
    3593                 :          44 :                             kind = GOMP_MAP_TO;
    3594                 :          48 :                           node3 = build_omp_clause (input_location,
    3595                 :             :                                                     OMP_CLAUSE_MAP);
    3596                 :          48 :                           OMP_CLAUSE_SET_MAP_KIND (node3, kind);
    3597                 :          48 :                           OMP_CLAUSE_DECL (node3) = se.string_length;
    3598                 :          48 :                           OMP_CLAUSE_SIZE (node3)
    3599                 :          96 :                             = TYPE_SIZE_UNIT (gfc_charlen_type_node);
    3600                 :             :                         }
    3601                 :             :                     }
    3602                 :             :                 }
    3603                 :         784 :               else if (n->expr
    3604                 :         784 :                        && n->expr->expr_type == EXPR_VARIABLE
    3605                 :         784 :                        && (n->expr->ref->type == REF_COMPONENT
    3606                 :             :                            || n->expr->ref->type == REF_ARRAY))
    3607                 :             :                 {
    3608                 :         784 :                   gfc_init_se (&se, NULL);
    3609                 :         784 :                   se.expr = gfc_maybe_dereference_var (n->sym, decl);
    3610                 :             : 
    3611                 :        2654 :                   for (gfc_ref *ref = n->expr->ref; ref; ref = ref->next)
    3612                 :             :                     {
    3613                 :        1870 :                       if (ref->type == REF_COMPONENT)
    3614                 :             :                         {
    3615                 :        1011 :                           if (ref->u.c.sym->attr.extension)
    3616                 :          91 :                             conv_parent_component_references (&se, ref);
    3617                 :             : 
    3618                 :        1011 :                           gfc_conv_component_ref (&se, ref);
    3619                 :             :                         }
    3620                 :         859 :                       else if (ref->type == REF_ARRAY)
    3621                 :             :                         {
    3622                 :         859 :                           if (ref->u.ar.type == AR_ELEMENT && ref->next)
    3623                 :         171 :                             gfc_conv_array_ref (&se, &ref->u.ar, n->expr,
    3624                 :         171 :                                                 &n->expr->where);
    3625                 :             :                           else
    3626                 :         688 :                             gcc_assert (!ref->next);
    3627                 :             :                         }
    3628                 :             :                       else
    3629                 :           0 :                         sorry ("unhandled expression type");
    3630                 :             :                     }
    3631                 :             : 
    3632                 :         784 :                   tree inner = se.expr;
    3633                 :             : 
    3634                 :             :                   /* Last component is a derived type or class pointer.  */
    3635                 :         784 :                   if (lastref->type == REF_COMPONENT
    3636                 :          96 :                       && (lastref->u.c.component->ts.type == BT_DERIVED
    3637                 :          24 :                           || lastref->u.c.component->ts.type == BT_CLASS))
    3638                 :             :                     {
    3639                 :          96 :                       if (pointer || (openacc && allocatable))
    3640                 :             :                         {
    3641                 :             :                           /* If it's a bare attach/detach clause, we just want
    3642                 :             :                              to perform a single attach/detach operation, of the
    3643                 :             :                              pointer itself, not of the pointed-to object.  */
    3644                 :          49 :                           if (openacc
    3645                 :          49 :                               && (n->u.map_op == OMP_MAP_ATTACH
    3646                 :          43 :                                   || n->u.map_op == OMP_MAP_DETACH))
    3647                 :             :                             {
    3648                 :          12 :                               OMP_CLAUSE_DECL (node)
    3649                 :          12 :                                 = build_fold_addr_expr (inner);
    3650                 :          12 :                               OMP_CLAUSE_SIZE (node) = size_zero_node;
    3651                 :          12 :                               goto finalize_map_clause;
    3652                 :             :                             }
    3653                 :             : 
    3654                 :          37 :                           tree data, size;
    3655                 :             : 
    3656                 :          37 :                           if (lastref->u.c.component->ts.type == BT_CLASS)
    3657                 :             :                             {
    3658                 :          24 :                               data = gfc_class_data_get (inner);
    3659                 :          24 :                               gcc_assert (POINTER_TYPE_P (TREE_TYPE (data)));
    3660                 :          24 :                               data = build_fold_indirect_ref (data);
    3661                 :          24 :                               size = gfc_class_vtab_size_get (inner);
    3662                 :             :                             }
    3663                 :             :                           else  /* BT_DERIVED.  */
    3664                 :             :                             {
    3665                 :          13 :                               data = inner;
    3666                 :          13 :                               size = TYPE_SIZE_UNIT (TREE_TYPE (inner));
    3667                 :             :                             }
    3668                 :             : 
    3669                 :          37 :                           OMP_CLAUSE_DECL (node) = data;
    3670                 :          37 :                           OMP_CLAUSE_SIZE (node) = size;
    3671                 :          37 :                           node2 = build_omp_clause (input_location,
    3672                 :             :                                                     OMP_CLAUSE_MAP);
    3673                 :          37 :                           OMP_CLAUSE_SET_MAP_KIND (node2,
    3674                 :             :                                                    openacc
    3675                 :             :                                                    ? GOMP_MAP_ATTACH_DETACH
    3676                 :             :                                                    : GOMP_MAP_ALWAYS_POINTER);
    3677                 :          37 :                           OMP_CLAUSE_DECL (node2) = build_fold_addr_expr (data);
    3678                 :          37 :                           OMP_CLAUSE_SIZE (node2) = size_int (0);
    3679                 :          37 :                         }
    3680                 :             :                       else
    3681                 :             :                         {
    3682                 :          47 :                           OMP_CLAUSE_DECL (node) = inner;
    3683                 :          47 :                           OMP_CLAUSE_SIZE (node)
    3684                 :          94 :                             = TYPE_SIZE_UNIT (TREE_TYPE (inner));
    3685                 :             :                         }
    3686                 :             :                     }
    3687                 :         688 :                   else if (lastref->type == REF_ARRAY
    3688                 :         688 :                            && lastref->u.ar.type == AR_FULL)
    3689                 :             :                     {
    3690                 :             :                       /* Bare attach and detach clauses don't want any
    3691                 :             :                          additional nodes.  */
    3692                 :         399 :                       if ((n->u.map_op == OMP_MAP_ATTACH
    3693                 :         368 :                            || n->u.map_op == OMP_MAP_DETACH)
    3694                 :         413 :                           && (POINTER_TYPE_P (TREE_TYPE (inner))
    3695                 :          45 :                               || GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (inner))))
    3696                 :             :                         {
    3697                 :          45 :                           if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (inner)))
    3698                 :             :                             {
    3699                 :          45 :                               tree ptr = gfc_conv_descriptor_data_get (inner);
    3700                 :          45 :                               OMP_CLAUSE_DECL (node) = ptr;
    3701                 :             :                             }
    3702                 :             :                           else
    3703                 :           0 :                             OMP_CLAUSE_DECL (node) = inner;
    3704                 :          45 :                           OMP_CLAUSE_SIZE (node) = size_zero_node;
    3705                 :          45 :                           goto finalize_map_clause;
    3706                 :             :                         }
    3707                 :             : 
    3708                 :         354 :                       if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (inner)))
    3709                 :             :                         {
    3710                 :         196 :                           gomp_map_kind map_kind;
    3711                 :         196 :                           tree desc_node;
    3712                 :         196 :                           tree type = TREE_TYPE (inner);
    3713                 :         196 :                           tree ptr = gfc_conv_descriptor_data_get (inner);
    3714                 :         196 :                           ptr = build_fold_indirect_ref (ptr);
    3715                 :         196 :                           OMP_CLAUSE_DECL (node) = ptr;
    3716                 :         196 :                           int rank = GFC_TYPE_ARRAY_RANK (type);
    3717                 :         196 :                           OMP_CLAUSE_SIZE (node)
    3718                 :         196 :                             = gfc_full_array_size (block, inner, rank);
    3719                 :         196 :                           tree elemsz
    3720                 :         196 :                             = TYPE_SIZE_UNIT (gfc_get_element_type (type));
    3721                 :         196 :                           map_kind = OMP_CLAUSE_MAP_KIND (node);
    3722                 :         196 :                           if (GOMP_MAP_COPY_TO_P (map_kind)
    3723                 :          81 :                               || map_kind == GOMP_MAP_ALLOC)
    3724                 :         128 :                             map_kind = ((GOMP_MAP_ALWAYS_P (map_kind)
    3725                 :         196 :                                          || gfc_expr_attr (n->expr).pointer)
    3726                 :         128 :                                         ? GOMP_MAP_ALWAYS_TO : GOMP_MAP_TO);
    3727                 :          68 :                           else if (n->u.map_op == OMP_MAP_RELEASE
    3728                 :          67 :                                    || n->u.map_op == OMP_MAP_DELETE)
    3729                 :             :                             ;
    3730                 :          67 :                           else if (op == EXEC_OMP_TARGET_EXIT_DATA)
    3731                 :             :                             map_kind = GOMP_MAP_RELEASE;
    3732                 :             :                           else
    3733                 :          59 :                             map_kind = GOMP_MAP_ALLOC;
    3734                 :         196 :                           if (!openacc
    3735                 :          60 :                               && n->expr->ts.type == BT_CHARACTER
    3736                 :          36 :                               && n->expr->ts.deferred)
    3737                 :             :                             {
    3738                 :          36 :                               gcc_assert (se.string_length);
    3739                 :          36 :                               tree len = fold_convert (size_type_node,
    3740                 :             :                                                        se.string_length);
    3741                 :          36 :                               elemsz = gfc_get_char_type (n->expr->ts.kind);
    3742                 :          36 :                               elemsz = TYPE_SIZE_UNIT (elemsz);
    3743                 :          36 :                               elemsz = fold_build2 (MULT_EXPR, size_type_node,
    3744                 :             :                                                     len, elemsz);
    3745                 :          36 :                               node4 = build_omp_clause (input_location,
    3746                 :             :                                                         OMP_CLAUSE_MAP);
    3747                 :          36 :                               OMP_CLAUSE_SET_MAP_KIND (node4, map_kind);
    3748                 :          36 :                               OMP_CLAUSE_DECL (node4) = se.string_length;
    3749                 :          36 :                               OMP_CLAUSE_SIZE (node4)
    3750                 :          72 :                                 = TYPE_SIZE_UNIT (gfc_charlen_type_node);
    3751                 :             :                             }
    3752                 :         196 :                           elemsz = fold_convert (gfc_array_index_type, elemsz);
    3753                 :         196 :                           OMP_CLAUSE_SIZE (node)
    3754                 :         196 :                             = fold_build2 (MULT_EXPR, gfc_array_index_type,
    3755                 :             :                                            OMP_CLAUSE_SIZE (node), elemsz);
    3756                 :         196 :                           desc_node = build_omp_clause (input_location,
    3757                 :             :                                                         OMP_CLAUSE_MAP);
    3758                 :         196 :                           if (openacc)
    3759                 :         136 :                             OMP_CLAUSE_SET_MAP_KIND (desc_node,
    3760                 :             :                                                      GOMP_MAP_TO_PSET);
    3761                 :             :                           else
    3762                 :          60 :                             OMP_CLAUSE_SET_MAP_KIND (desc_node, map_kind);
    3763                 :         196 :                           OMP_CLAUSE_DECL (desc_node) = inner;
    3764                 :         196 :                           OMP_CLAUSE_SIZE (desc_node) = TYPE_SIZE_UNIT (type);
    3765                 :         196 :                           if (openacc)
    3766                 :         136 :                             node2 = desc_node;
    3767                 :             :                           else
    3768                 :             :                             {
    3769                 :          60 :                               node2 = node;
    3770                 :          60 :                               node = desc_node;  /* Put first.  */
    3771                 :             :                             }
    3772                 :         196 :                           if (op == EXEC_OMP_TARGET_EXIT_DATA)
    3773                 :           8 :                             goto finalize_map_clause;
    3774                 :         188 :                           node3 = build_omp_clause (input_location,
    3775                 :             :                                                     OMP_CLAUSE_MAP);
    3776                 :         240 :                           OMP_CLAUSE_SET_MAP_KIND (node3,
    3777                 :             :                                                    openacc
    3778                 :             :                                                    ? GOMP_MAP_ATTACH_DETACH
    3779                 :             :                                                    : GOMP_MAP_ALWAYS_POINTER);
    3780                 :         188 :                           OMP_CLAUSE_DECL (node3)
    3781                 :         188 :                             = gfc_conv_descriptor_data_get (inner);
    3782                 :             :                           /* Similar to gfc_trans_omp_array_section (details
    3783                 :             :                              there), we add/keep the cast for OpenMP to prevent
    3784                 :             :                              that an 'alloc:' gets added for node3 ('desc.data')
    3785                 :             :                              as that is part of the whole descriptor (node3).
    3786                 :             :                              TODO: Remove once the ME handles this properly.  */
    3787                 :         188 :                           if (!openacc)
    3788                 :          52 :                             OMP_CLAUSE_DECL (node3)
    3789                 :         104 :                                 = fold_convert (TREE_TYPE (TREE_OPERAND(ptr, 0)),
    3790                 :             :                                                 OMP_CLAUSE_DECL (node3));
    3791                 :             :                           else
    3792                 :         136 :                             STRIP_NOPS (OMP_CLAUSE_DECL (node3));
    3793                 :         188 :                           OMP_CLAUSE_SIZE (node3) = size_int (0);
    3794                 :             :                         }
    3795                 :             :                       else
    3796                 :         158 :                         OMP_CLAUSE_DECL (node) = inner;
    3797                 :             :                     }
    3798                 :         289 :                   else if (lastref->type == REF_ARRAY)
    3799                 :             :                     {
    3800                 :             :                       /* An array element or section.  */
    3801                 :         289 :                       bool element = lastref->u.ar.type == AR_ELEMENT;
    3802                 :         289 :                       gomp_map_kind kind = (openacc ? GOMP_MAP_ATTACH_DETACH
    3803                 :             :                                                     : GOMP_MAP_ALWAYS_POINTER);
    3804                 :         289 :                       gfc_trans_omp_array_section (block, op, n, inner, element,
    3805                 :             :                                                    kind, node, node2, node3,
    3806                 :             :                                                    node4);
    3807                 :             :                     }
    3808                 :             :                   else
    3809                 :           0 :                     gcc_unreachable ();
    3810                 :             :                 }
    3811                 :             :               else
    3812                 :           0 :                 sorry ("unhandled expression");
    3813                 :             : 
    3814                 :       12794 :               finalize_map_clause:
    3815                 :             : 
    3816                 :       12794 :               omp_clauses = gfc_trans_add_clause (node, omp_clauses);
    3817                 :       12794 :               if (node2)
    3818                 :        3525 :                 omp_clauses = gfc_trans_add_clause (node2, omp_clauses);
    3819                 :       12794 :               if (node3)
    3820                 :        4704 :                 omp_clauses = gfc_trans_add_clause (node3, omp_clauses);
    3821                 :       12794 :               if (node4)
    3822                 :        3360 :                 omp_clauses = gfc_trans_add_clause (node4, omp_clauses);
    3823                 :       12794 :               if (node5)
    3824                 :           4 :                 omp_clauses = gfc_trans_add_clause (node5, omp_clauses);
    3825                 :             :             }
    3826                 :             :           break;
    3827                 :             :         case OMP_LIST_TO:
    3828                 :             :         case OMP_LIST_FROM:
    3829                 :             :         case OMP_LIST_CACHE:
    3830                 :        3597 :           for (; n != NULL; n = n->next)
    3831                 :             :             {
    3832                 :        1837 :               if (!n->sym->attr.referenced)
    3833                 :           0 :                 continue;
    3834                 :             : 
    3835                 :        1837 :               switch (list)
    3836                 :             :                 {
    3837                 :             :                 case OMP_LIST_TO:
    3838                 :             :                   clause_code = OMP_CLAUSE_TO;
    3839                 :             :                   break;
    3840                 :        1028 :                 case OMP_LIST_FROM:
    3841                 :        1028 :                   clause_code = OMP_CLAUSE_FROM;
    3842                 :        1028 :                   break;
    3843                 :          58 :                 case OMP_LIST_CACHE:
    3844                 :          58 :                   clause_code = OMP_CLAUSE__CACHE_;
    3845                 :          58 :                   break;
    3846                 :           0 :                 default:
    3847                 :           0 :                   gcc_unreachable ();
    3848                 :             :                 }
    3849                 :        1837 :               tree node = build_omp_clause (input_location, clause_code);
    3850                 :        1837 :               if (n->expr == NULL
    3851                 :         104 :                   || (n->expr->ref->type == REF_ARRAY
    3852                 :          92 :                       && n->expr->ref->u.ar.type == AR_FULL
    3853                 :           0 :                       && n->expr->ref->next == NULL))
    3854                 :             :                 {
    3855                 :        1733 :                   tree decl = gfc_trans_omp_variable (n->sym, false);
    3856                 :        1733 :                   if (gfc_omp_privatize_by_reference (decl))
    3857                 :             :                     {
    3858                 :        1047 :                       if (gfc_omp_is_allocatable_or_ptr (decl))
    3859                 :         240 :                         decl = build_fold_indirect_ref (decl);
    3860                 :        1047 :                       decl = build_fold_indirect_ref (decl);
    3861                 :             :                     }
    3862                 :         686 :                   else if (DECL_P (decl))
    3863                 :         686 :                     TREE_ADDRESSABLE (decl) = 1;
    3864                 :        1733 :                   if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (decl)))
    3865                 :             :                     {
    3866                 :         597 :                       tree type = TREE_TYPE (decl);
    3867                 :         597 :                       tree ptr = gfc_conv_descriptor_data_get (decl);
    3868                 :         597 :                       gcc_assert (POINTER_TYPE_P (TREE_TYPE (ptr)));
    3869                 :         597 :                       ptr = build_fold_indirect_ref (ptr);
    3870                 :         597 :                       OMP_CLAUSE_DECL (node) = ptr;
    3871                 :         597 :                       OMP_CLAUSE_SIZE (node)
    3872                 :         597 :                         = gfc_full_array_size (block, decl,
    3873                 :         597 :                                                GFC_TYPE_ARRAY_RANK (type));
    3874                 :         597 :                       tree elemsz
    3875                 :         597 :                         = TYPE_SIZE_UNIT (gfc_get_element_type (type));
    3876                 :         597 :                       elemsz = fold_convert (gfc_array_index_type, elemsz);
    3877                 :        1194 :                       OMP_CLAUSE_SIZE (node)
    3878                 :        1194 :                         = fold_build2 (MULT_EXPR, gfc_array_index_type,
    3879                 :             :                                        OMP_CLAUSE_SIZE (node), elemsz);
    3880                 :             :                     }
    3881                 :             :                   else
    3882                 :             :                     {
    3883                 :        1136 :                       OMP_CLAUSE_DECL (node) = decl;
    3884                 :        1136 :                       if (gfc_omp_is_allocatable_or_ptr (decl))
    3885                 :         120 :                         OMP_CLAUSE_SIZE (node)
    3886                 :         240 :                                 = TYPE_SIZE_UNIT (TREE_TYPE (TREE_TYPE (decl)));
    3887                 :             :                     }
    3888                 :             :                 }
    3889                 :             :               else
    3890                 :             :                 {
    3891                 :         104 :                   tree ptr;
    3892                 :         104 :                   gfc_init_se (&se, NULL);
    3893                 :         104 :                   if (n->expr->rank == 0)
    3894                 :             :                     {
    3895                 :           5 :                       gfc_conv_expr_reference (&se, n->expr);
    3896                 :           5 :                       ptr = se.expr;
    3897                 :           5 :                       gfc_add_block_to_block (block, &se.pre);
    3898                 :           5 :                       OMP_CLAUSE_SIZE (node)
    3899                 :          10 :                         = TYPE_SIZE_UNIT (TREE_TYPE (TREE_TYPE (ptr)));
    3900                 :             :                     }
    3901                 :             :                   else
    3902                 :             :                     {
    3903                 :          99 :                       gfc_conv_expr_descriptor (&se, n->expr);
    3904                 :          99 :                       ptr = gfc_conv_array_data (se.expr);
    3905                 :          99 :                       tree type = TREE_TYPE (se.expr);
    3906                 :          99 :                       gfc_add_block_to_block (block, &se.pre);
    3907                 :          99 :                       OMP_CLAUSE_SIZE (node)
    3908                 :          99 :                         = gfc_full_array_size (block, se.expr,
    3909                 :          99 :                                                GFC_TYPE_ARRAY_RANK (type));
    3910                 :          99 :                       tree elemsz
    3911                 :          99 :                         = TYPE_SIZE_UNIT (gfc_get_element_type (type));
    3912                 :          99 :                       elemsz = fold_convert (gfc_array_index_type, elemsz);
    3913                 :         198 :                       OMP_CLAUSE_SIZE (node)
    3914                 :         198 :                         = fold_build2 (MULT_EXPR, gfc_array_index_type,
    3915                 :             :                                        OMP_CLAUSE_SIZE (node), elemsz);
    3916                 :             :                     }
    3917                 :         104 :                   gfc_add_block_to_block (block, &se.post);
    3918                 :         104 :                   gcc_assert (POINTER_TYPE_P (TREE_TYPE (ptr)));
    3919                 :         104 :                   OMP_CLAUSE_DECL (node) = build_fold_indirect_ref (ptr);
    3920                 :             :                 }
    3921                 :        1837 :               if (n->u.present_modifier)
    3922                 :           5 :                 OMP_CLAUSE_MOTION_PRESENT (node) = 1;
    3923                 :        1837 :               omp_clauses = gfc_trans_add_clause (node, omp_clauses);
    3924                 :             :             }
    3925                 :             :           break;
    3926                 :             :         case OMP_LIST_USES_ALLOCATORS:
    3927                 :             :           /* Ignore pre-defined allocators as no special treatment is needed. */
    3928                 :          30 :           for (; n != NULL; n = n->next)
    3929                 :          28 :             if (n->sym->attr.flavor == FL_VARIABLE)
    3930                 :             :               break;
    3931                 :          12 :           if (n != NULL)
    3932                 :          10 :             sorry_at (input_location, "%<uses_allocators%> clause with traits "
    3933                 :             :                                       "and memory spaces");
    3934                 :             :           break;
    3935                 :             :         default:
    3936                 :             :           break;
    3937                 :             :         }
    3938                 :             :     }
    3939                 :             : 
    3940                 :       28074 :   if (clauses->if_expr)
    3941                 :             :     {
    3942                 :         820 :       tree if_var;
    3943                 :             : 
    3944                 :         820 :       gfc_init_se (&se, NULL);
    3945                 :         820 :       gfc_conv_expr (&se, clauses->if_expr);
    3946                 :         820 :       gfc_add_block_to_block (block, &se.pre);
    3947                 :         820 :       if_var = gfc_evaluate_now (se.expr, block);
    3948                 :         820 :       gfc_add_block_to_block (block, &se.post);
    3949                 :             : 
    3950                 :         820 :       c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_IF);
    3951                 :         820 :       OMP_CLAUSE_IF_MODIFIER (c) = ERROR_MARK;
    3952                 :         820 :       OMP_CLAUSE_IF_EXPR (c) = if_var;
    3953                 :         820 :       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
    3954                 :             :     }
    3955                 :      308814 :   for (ifc = 0; ifc < OMP_IF_LAST; ifc++)
    3956                 :      280740 :     if (clauses->if_exprs[ifc])
    3957                 :             :       {
    3958                 :         123 :         tree if_var;
    3959                 :             : 
    3960                 :         123 :         gfc_init_se (&se, NULL);
    3961                 :         123 :         gfc_conv_expr (&se, clauses->if_exprs[ifc]);
    3962                 :         123 :         gfc_add_block_to_block (block, &se.pre);
    3963                 :         123 :         if_var = gfc_evaluate_now (se.expr, block);
    3964                 :         123 :         gfc_add_block_to_block (block, &se.post);
    3965                 :             : 
    3966                 :         123 :         c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_IF);
    3967                 :         123 :         switch (ifc)
    3968                 :             :           {
    3969                 :           0 :           case OMP_IF_CANCEL:
    3970                 :           0 :             OMP_CLAUSE_IF_MODIFIER (c) = VOID_CST;
    3971                 :           0 :             break;
    3972                 :          40 :           case OMP_IF_PARALLEL:
    3973                 :          40 :             OMP_CLAUSE_IF_MODIFIER (c) = OMP_PARALLEL;
    3974                 :          40 :             break;
    3975                 :          39 :           case OMP_IF_SIMD:
    3976                 :          39 :             OMP_CLAUSE_IF_MODIFIER (c) = OMP_SIMD;
    3977                 :          39 :             break;
    3978                 :           1 :           case OMP_IF_TASK:
    3979                 :           1 :             OMP_CLAUSE_IF_MODIFIER (c) = OMP_TASK;
    3980                 :           1 :             break;
    3981                 :          23 :           case OMP_IF_TASKLOOP:
    3982                 :          23 :             OMP_CLAUSE_IF_MODIFIER (c) = OMP_TASKLOOP;
    3983                 :          23 :             break;
    3984                 :          16 :           case OMP_IF_TARGET:
    3985                 :          16 :             OMP_CLAUSE_IF_MODIFIER (c) = OMP_TARGET;
    3986                 :          16 :             break;
    3987                 :           1 :           case OMP_IF_TARGET_DATA:
    3988                 :           1 :             OMP_CLAUSE_IF_MODIFIER (c) = OMP_TARGET_DATA;
    3989                 :           1 :             break;
    3990                 :           1 :           case OMP_IF_TARGET_UPDATE:
    3991                 :           1 :             OMP_CLAUSE_IF_MODIFIER (c) = OMP_TARGET_UPDATE;
    3992                 :           1 :             break;
    3993                 :           1 :           case OMP_IF_TARGET_ENTER_DATA:
    3994                 :           1 :             OMP_CLAUSE_IF_MODIFIER (c) = OMP_TARGET_ENTER_DATA;
    3995                 :           1 :             break;
    3996                 :           1 :           case OMP_IF_TARGET_EXIT_DATA:
    3997                 :           1 :             OMP_CLAUSE_IF_MODIFIER (c) = OMP_TARGET_EXIT_DATA;
    3998                 :           1 :             break;
    3999                 :             :           default:
    4000                 :             :             gcc_unreachable ();
    4001                 :             :           }
    4002                 :         123 :         OMP_CLAUSE_IF_EXPR (c) = if_var;
    4003                 :         123 :         omp_clauses = gfc_trans_add_clause (c, omp_clauses);
    4004                 :             :       }
    4005                 :             : 
    4006                 :       28074 :   if (clauses->final_expr)
    4007                 :             :     {
    4008                 :          64 :       tree final_var;
    4009                 :             : 
    4010                 :          64 :       gfc_init_se (&se, NULL);
    4011                 :          64 :       gfc_conv_expr (&se, clauses->final_expr);
    4012                 :          64 :       gfc_add_block_to_block (block, &se.pre);
    4013                 :          64 :       final_var = gfc_evaluate_now (se.expr, block);
    4014                 :          64 :       gfc_add_block_to_block (block, &se.post);
    4015                 :             : 
    4016                 :          64 :       c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_FINAL);
    4017                 :          64 :       OMP_CLAUSE_FINAL_EXPR (c) = final_var;
    4018                 :          64 :       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
    4019                 :             :     }
    4020                 :             : 
    4021                 :       28074 :   if (clauses->num_threads)
    4022                 :             :     {
    4023                 :         942 :       tree num_threads;
    4024                 :             : 
    4025                 :         942 :       gfc_init_se (&se, NULL);
    4026                 :         942 :       gfc_conv_expr (&se, clauses->num_threads);
    4027                 :         942 :       gfc_add_block_to_block (block, &se.pre);
    4028                 :         942 :       num_threads = gfc_evaluate_now (se.expr, block);
    4029                 :         942 :       gfc_add_block_to_block (block, &se.post);
    4030                 :             : 
    4031                 :         942 :       c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_NUM_THREADS);
    4032                 :         942 :       OMP_CLAUSE_NUM_THREADS_EXPR (c) = num_threads;
    4033                 :         942 :       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
    4034                 :             :     }
    4035                 :             : 
    4036                 :       28074 :   chunk_size = NULL_TREE;
    4037                 :       28074 :   if (clauses->chunk_size)
    4038                 :             :     {
    4039                 :         487 :       gfc_init_se (&se, NULL);
    4040                 :         487 :       gfc_conv_expr (&se, clauses->chunk_size);
    4041                 :         487 :       gfc_add_block_to_block (block, &se.pre);
    4042                 :         487 :       chunk_size = gfc_evaluate_now (se.expr, block);
    4043                 :         487 :       gfc_add_block_to_block (block, &se.post);
    4044                 :             :     }
    4045                 :             : 
    4046                 :       28074 :   if (clauses->sched_kind != OMP_SCHED_NONE)
    4047                 :             :     {
    4048                 :         748 :       c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_SCHEDULE);
    4049                 :         748 :       OMP_CLAUSE_SCHEDULE_CHUNK_EXPR (c) = chunk_size;
    4050                 :         748 :       switch (clauses->sched_kind)
    4051                 :             :         {
    4052                 :         387 :         case OMP_SCHED_STATIC:
    4053                 :         387 :           OMP_CLAUSE_SCHEDULE_KIND (c) = OMP_CLAUSE_SCHEDULE_STATIC;
    4054                 :         387 :           break;
    4055                 :         159 :         case OMP_SCHED_DYNAMIC:
    4056                 :         159 :           OMP_CLAUSE_SCHEDULE_KIND (c) = OMP_CLAUSE_SCHEDULE_DYNAMIC;
    4057                 :         159 :           break;
    4058                 :         111 :         case OMP_SCHED_GUIDED:
    4059                 :         111 :           OMP_CLAUSE_SCHEDULE_KIND (c) = OMP_CLAUSE_SCHEDULE_GUIDED;
    4060                 :         111 :           break;
    4061                 :          84 :         case OMP_SCHED_RUNTIME:
    4062                 :          84 :           OMP_CLAUSE_SCHEDULE_KIND (c) = OMP_CLAUSE_SCHEDULE_RUNTIME;
    4063                 :          84 :           break;
    4064                 :           7 :         case OMP_SCHED_AUTO:
    4065                 :           7 :           OMP_CLAUSE_SCHEDULE_KIND (c) = OMP_CLAUSE_SCHEDULE_AUTO;
    4066                 :           7 :           break;
    4067                 :           0 :         default:
    4068                 :           0 :           gcc_unreachable ();
    4069                 :             :         }
    4070                 :         748 :       if (clauses->sched_monotonic)
    4071                 :          54 :         OMP_CLAUSE_SCHEDULE_KIND (c)
    4072                 :          27 :           = (omp_clause_schedule_kind) (OMP_CLAUSE_SCHEDULE_KIND (c)
    4073                 :             :                                         | OMP_CLAUSE_SCHEDULE_MONOTONIC);
    4074                 :         721 :       else if (clauses->sched_nonmonotonic)
    4075                 :          46 :         OMP_CLAUSE_SCHEDULE_KIND (c)
    4076                 :          23 :           = (omp_clause_schedule_kind) (OMP_CLAUSE_SCHEDULE_KIND (c)
    4077                 :             :                                         | OMP_CLAUSE_SCHEDULE_NONMONOTONIC);
    4078                 :         748 :       if (clauses->sched_simd)
    4079                 :          17 :         OMP_CLAUSE_SCHEDULE_SIMD (c) = 1;
    4080                 :         748 :       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
    4081                 :             :     }
    4082                 :             : 
    4083                 :       28074 :   if (clauses->default_sharing != OMP_DEFAULT_UNKNOWN)
    4084                 :             :     {
    4085                 :        1043 :       c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_DEFAULT);
    4086                 :        1043 :       switch (clauses->default_sharing)
    4087                 :             :         {
    4088                 :         639 :         case OMP_DEFAULT_NONE:
    4089                 :         639 :           OMP_CLAUSE_DEFAULT_KIND (c) = OMP_CLAUSE_DEFAULT_NONE;
    4090                 :         639 :           break;
    4091                 :         183 :         case OMP_DEFAULT_SHARED:
    4092                 :         183 :           OMP_CLAUSE_DEFAULT_KIND (c) = OMP_CLAUSE_DEFAULT_SHARED;
    4093                 :         183 :           break;
    4094                 :          24 :         case OMP_DEFAULT_PRIVATE:
    4095                 :          24 :           OMP_CLAUSE_DEFAULT_KIND (c) = OMP_CLAUSE_DEFAULT_PRIVATE;
    4096                 :          24 :           break;
    4097                 :           7 :         case OMP_DEFAULT_FIRSTPRIVATE:
    4098                 :           7 :           OMP_CLAUSE_DEFAULT_KIND (c) = OMP_CLAUSE_DEFAULT_FIRSTPRIVATE;
    4099                 :           7 :           break;
    4100                 :         190 :         case OMP_DEFAULT_PRESENT:
    4101                 :         190 :           OMP_CLAUSE_DEFAULT_KIND (c) = OMP_CLAUSE_DEFAULT_PRESENT;
    4102                 :         190 :           break;
    4103                 :           0 :         default:
    4104                 :           0 :           gcc_unreachable ();
    4105                 :             :         }
    4106                 :        1043 :       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
    4107                 :             :     }
    4108                 :             : 
    4109                 :       28074 :   if (clauses->nowait)
    4110                 :             :     {
    4111                 :        1742 :       c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_NOWAIT);
    4112                 :        1742 :       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
    4113                 :             :     }
    4114                 :             : 
    4115                 :       28074 :   if (clauses->ordered)
    4116                 :             :     {
    4117                 :         312 :       c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_ORDERED);
    4118                 :         312 :       OMP_CLAUSE_ORDERED_EXPR (c)
    4119                 :         312 :         = clauses->orderedc ? build_int_cst (integer_type_node,
    4120                 :         131 :                                              clauses->orderedc) : NULL_TREE;
    4121                 :         312 :       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
    4122                 :             :     }
    4123                 :             : 
    4124                 :       28074 :   if (clauses->order_concurrent)
    4125                 :             :     {
    4126                 :         303 :       c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_ORDER);
    4127                 :         303 :       OMP_CLAUSE_ORDER_UNCONSTRAINED (c) = clauses->order_unconstrained;
    4128                 :         303 :       OMP_CLAUSE_ORDER_REPRODUCIBLE (c) = clauses->order_reproducible;
    4129                 :         303 :       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
    4130                 :             :     }
    4131                 :             : 
    4132                 :       28074 :   if (clauses->untied)
    4133                 :             :     {
    4134                 :         141 :       c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_UNTIED);
    4135                 :         141 :       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
    4136                 :             :     }
    4137                 :             : 
    4138                 :       28074 :   if (clauses->mergeable)
    4139                 :             :     {
    4140                 :          32 :       c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_MERGEABLE);
    4141                 :          32 :       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
    4142                 :             :     }
    4143                 :             : 
    4144                 :       28074 :   if (clauses->collapse)
    4145                 :             :     {
    4146                 :        1581 :       c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_COLLAPSE);
    4147                 :        1581 :       OMP_CLAUSE_COLLAPSE_EXPR (c)
    4148                 :        1581 :         = build_int_cst (integer_type_node, clauses->collapse);
    4149                 :        1581 :       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
    4150                 :             :     }
    4151                 :             : 
    4152                 :       28074 :   if (clauses->inbranch)
    4153                 :             :     {
    4154                 :          18 :       c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_INBRANCH);
    4155                 :          18 :       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
    4156                 :             :     }
    4157                 :             : 
    4158                 :       28074 :   if (clauses->notinbranch)
    4159                 :             :     {
    4160                 :          28 :       c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_NOTINBRANCH);
    4161                 :          28 :       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
    4162                 :             :     }
    4163                 :             : 
    4164                 :       28074 :   switch (clauses->cancel)
    4165                 :             :     {
    4166                 :             :     case OMP_CANCEL_UNKNOWN:
    4167                 :             :       break;
    4168                 :           0 :     case OMP_CANCEL_PARALLEL:
    4169                 :           0 :       c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_PARALLEL);
    4170                 :           0 :       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
    4171                 :           0 :       break;
    4172                 :           0 :     case OMP_CANCEL_SECTIONS:
    4173                 :           0 :       c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_SECTIONS);
    4174                 :           0 :       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
    4175                 :           0 :       break;
    4176                 :           0 :     case OMP_CANCEL_DO:
    4177                 :           0 :       c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_FOR);
    4178                 :           0 :       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
    4179                 :           0 :       break;
    4180                 :           0 :     case OMP_CANCEL_TASKGROUP:
    4181                 :           0 :       c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_TASKGROUP);
    4182                 :           0 :       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
    4183                 :           0 :       break;
    4184                 :             :     }
    4185                 :             : 
    4186                 :       28074 :   if (clauses->proc_bind != OMP_PROC_BIND_UNKNOWN)
    4187                 :             :     {
    4188                 :          64 :       c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_PROC_BIND);
    4189                 :          64 :       switch (clauses->proc_bind)
    4190                 :             :         {
    4191                 :           1 :         case OMP_PROC_BIND_PRIMARY:
    4192                 :           1 :           OMP_CLAUSE_PROC_BIND_KIND (c) = OMP_CLAUSE_PROC_BIND_PRIMARY;
    4193                 :           1 :           break;
    4194                 :           9 :         case OMP_PROC_BIND_MASTER:
    4195                 :           9 :           OMP_CLAUSE_PROC_BIND_KIND (c) = OMP_CLAUSE_PROC_BIND_MASTER;
    4196                 :           9 :           break;
    4197                 :          53 :         case OMP_PROC_BIND_SPREAD:
    4198                 :          53 :           OMP_CLAUSE_PROC_BIND_KIND (c) = OMP_CLAUSE_PROC_BIND_SPREAD;
    4199                 :          53 :           break;
    4200                 :           1 :         case OMP_PROC_BIND_CLOSE:
    4201                 :           1 :           OMP_CLAUSE_PROC_BIND_KIND (c) = OMP_CLAUSE_PROC_BIND_CLOSE;
    4202                 :           1 :           break;
    4203                 :           0 :         default:
    4204                 :           0 :           gcc_unreachable ();
    4205                 :             :         }
    4206                 :          64 :       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
    4207                 :             :     }
    4208                 :             : 
    4209                 :       28074 :   if (clauses->safelen_expr)
    4210                 :             :     {
    4211                 :          89 :       tree safelen_var;
    4212                 :             : 
    4213                 :          89 :       gfc_init_se (&se, NULL);
    4214                 :          89 :       gfc_conv_expr (&se, clauses->safelen_expr);
    4215                 :          89 :       gfc_add_block_to_block (block, &se.pre);
    4216                 :          89 :       safelen_var = gfc_evaluate_now (se.expr, block);
    4217                 :          89 :       gfc_add_block_to_block (block, &se.post);
    4218                 :             : 
    4219                 :          89 :       c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_SAFELEN);
    4220                 :          89 :       OMP_CLAUSE_SAFELEN_EXPR (c) = safelen_var;
    4221                 :          89 :       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
    4222                 :             :     }
    4223                 :             : 
    4224                 :       28074 :   if (clauses->simdlen_expr)
    4225                 :             :     {
    4226                 :         110 :       if (declare_simd)
    4227                 :             :         {
    4228                 :          65 :           c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_SIMDLEN);
    4229                 :          65 :           OMP_CLAUSE_SIMDLEN_EXPR (c)
    4230                 :          65 :             = gfc_conv_constant_to_tree (clauses->simdlen_expr);
    4231                 :          65 :           omp_clauses = gfc_trans_add_clause (c, omp_clauses);
    4232                 :             :         }
    4233                 :             :       else
    4234                 :             :         {
    4235                 :          45 :           tree simdlen_var;
    4236                 :             : 
    4237                 :          45 :           gfc_init_se (&se, NULL);
    4238                 :          45 :           gfc_conv_expr (&se, clauses->simdlen_expr);
    4239                 :          45 :           gfc_add_block_to_block (block, &se.pre);
    4240                 :          45 :           simdlen_var = gfc_evaluate_now (se.expr, block);
    4241                 :          45 :           gfc_add_block_to_block (block, &se.post);
    4242                 :             : 
    4243                 :          45 :           c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_SIMDLEN);
    4244                 :          45 :           OMP_CLAUSE_SIMDLEN_EXPR (c) = simdlen_var;
    4245                 :          45 :           omp_clauses = gfc_trans_add_clause (c, omp_clauses);
    4246                 :             :         }
    4247                 :             :     }
    4248                 :             : 
    4249                 :       28074 :   if (clauses->num_teams_upper)
    4250                 :             :     {
    4251                 :         111 :       tree num_teams_lower = NULL_TREE, num_teams_upper;
    4252                 :             : 
    4253                 :         111 :       gfc_init_se (&se, NULL);
    4254                 :         111 :       gfc_conv_expr (&se, clauses->num_teams_upper);
    4255                 :         111 :       gfc_add_block_to_block (block, &se.pre);
    4256                 :         111 :       num_teams_upper = gfc_evaluate_now (se.expr, block);
    4257                 :         111 :       gfc_add_block_to_block (block, &se.post);
    4258                 :             : 
    4259                 :         111 :       if (clauses->num_teams_lower)
    4260                 :             :         {
    4261                 :          21 :           gfc_init_se (&se, NULL);
    4262                 :          21 :           gfc_conv_expr (&se, clauses->num_teams_lower);
    4263                 :          21 :           gfc_add_block_to_block (block, &se.pre);
    4264                 :          21 :           num_teams_lower = gfc_evaluate_now (se.expr, block);
    4265                 :          21 :           gfc_add_block_to_block (block, &se.post);
    4266                 :             :         }
    4267                 :         111 :       c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_NUM_TEAMS);
    4268                 :         111 :       OMP_CLAUSE_NUM_TEAMS_LOWER_EXPR (c) = num_teams_lower;
    4269                 :         111 :       OMP_CLAUSE_NUM_TEAMS_UPPER_EXPR (c) = num_teams_upper;
    4270                 :         111 :       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
    4271                 :             :     }
    4272                 :             : 
    4273                 :       28074 :   if (clauses->device)
    4274                 :             :     {
    4275                 :         205 :       tree device;
    4276                 :             : 
    4277                 :         205 :       gfc_init_se (&se, NULL);
    4278                 :         205 :       gfc_conv_expr (&se, clauses->device);
    4279                 :         205 :       gfc_add_block_to_block (block, &se.pre);
    4280                 :         205 :       device = gfc_evaluate_now (se.expr, block);
    4281                 :         205 :       gfc_add_block_to_block (block, &se.post);
    4282                 :             : 
    4283                 :         205 :       c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_DEVICE);
    4284                 :         205 :       OMP_CLAUSE_DEVICE_ID (c) = device;
    4285                 :             : 
    4286                 :         205 :       if (clauses->ancestor)
    4287                 :          39 :         OMP_CLAUSE_DEVICE_ANCESTOR (c) = 1;
    4288                 :             : 
    4289                 :         205 :       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
    4290                 :             :     }
    4291                 :             : 
    4292                 :       28074 :   if (clauses->thread_limit)
    4293                 :             :     {
    4294                 :         105 :       tree thread_limit;
    4295                 :             : 
    4296                 :         105 :       gfc_init_se (&se, NULL);
    4297                 :         105 :       gfc_conv_expr (&se, clauses->thread_limit);
    4298                 :         105 :       gfc_add_block_to_block (block, &se.pre);
    4299                 :         105 :       thread_limit = gfc_evaluate_now (se.expr, block);
    4300                 :         105 :       gfc_add_block_to_block (block, &se.post);
    4301                 :             : 
    4302                 :         105 :       c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_THREAD_LIMIT);
    4303                 :         105 :       OMP_CLAUSE_THREAD_LIMIT_EXPR (c) = thread_limit;
    4304                 :         105 :       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
    4305                 :             :     }
    4306                 :             : 
    4307                 :       28074 :   chunk_size = NULL_TREE;
    4308                 :       28074 :   if (clauses->dist_chunk_size)
    4309                 :             :     {
    4310                 :          81 :       gfc_init_se (&se, NULL);
    4311                 :          81 :       gfc_conv_expr (&se, clauses->dist_chunk_size);
    4312                 :          81 :       gfc_add_block_to_block (block, &se.pre);
    4313                 :          81 :       chunk_size = gfc_evaluate_now (se.expr, block);
    4314                 :          81 :       gfc_add_block_to_block (block, &se.post);
    4315                 :             :     }
    4316                 :             : 
    4317                 :       28074 :   if (clauses->dist_sched_kind != OMP_SCHED_NONE)
    4318                 :             :     {
    4319                 :          94 :       c = build_omp_clause (gfc_get_location (&where),
    4320                 :             :                             OMP_CLAUSE_DIST_SCHEDULE);
    4321                 :          94 :       OMP_CLAUSE_DIST_SCHEDULE_CHUNK_EXPR (c) = chunk_size;
    4322                 :          94 :       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
    4323                 :             :     }
    4324                 :             : 
    4325                 :       28074 :   if (clauses->grainsize)
    4326                 :             :     {
    4327                 :          43 :       tree grainsize;
    4328                 :             : 
    4329                 :          43 :       gfc_init_se (&se, NULL);
    4330                 :          43 :       gfc_conv_expr (&se, clauses->grainsize);
    4331                 :          43 :       gfc_add_block_to_block (block, &se.pre);
    4332                 :          43 :       grainsize = gfc_evaluate_now (se.expr, block);
    4333                 :          43 :       gfc_add_block_to_block (block, &se.post);
    4334                 :             : 
    4335                 :          43 :       c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_GRAINSIZE);
    4336                 :          43 :       OMP_CLAUSE_GRAINSIZE_EXPR (c) = grainsize;
    4337                 :          43 :       if (clauses->grainsize_strict)
    4338                 :           6 :         OMP_CLAUSE_GRAINSIZE_STRICT (c) = 1;
    4339                 :          43 :       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
    4340                 :             :     }
    4341                 :             : 
    4342                 :       28074 :   if (clauses->num_tasks)
    4343                 :             :     {
    4344                 :          35 :       tree num_tasks;
    4345                 :             : 
    4346                 :          35 :       gfc_init_se (&se, NULL);
    4347                 :          35 :       gfc_conv_expr (&se, clauses->num_tasks);
    4348                 :          35 :       gfc_add_block_to_block (block, &se.pre);
    4349                 :          35 :       num_tasks = gfc_evaluate_now (se.expr, block);
    4350                 :          35 :       gfc_add_block_to_block (block, &se.post);
    4351                 :             : 
    4352                 :          35 :       c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_NUM_TASKS);
    4353                 :          35 :       OMP_CLAUSE_NUM_TASKS_EXPR (c) = num_tasks;
    4354                 :          35 :       if (clauses->num_tasks_strict)
    4355                 :           6 :         OMP_CLAUSE_NUM_TASKS_STRICT (c) = 1;
    4356                 :          35 :       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
    4357                 :             :     }
    4358                 :             : 
    4359                 :       28074 :   if (clauses->priority)
    4360                 :             :     {
    4361                 :          34 :       tree priority;
    4362                 :             : 
    4363                 :          34 :       gfc_init_se (&se, NULL);
    4364                 :          34 :       gfc_conv_expr (&se, clauses->priority);
    4365                 :          34 :       gfc_add_block_to_block (block, &se.pre);
    4366                 :          34 :       priority = gfc_evaluate_now (se.expr, block);
    4367                 :          34 :       gfc_add_block_to_block (block, &se.post);
    4368                 :             : 
    4369                 :          34 :       c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_PRIORITY);
    4370                 :          34 :       OMP_CLAUSE_PRIORITY_EXPR (c) = priority;
    4371                 :          34 :       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
    4372                 :             :     }
    4373                 :             : 
    4374                 :       28074 :   if (clauses->detach)
    4375                 :             :     {
    4376                 :         116 :       tree detach;
    4377                 :             : 
    4378                 :         116 :       gfc_init_se (&se, NULL);
    4379                 :         116 :       gfc_conv_expr (&se, clauses->detach);
    4380                 :         116 :       gfc_add_block_to_block (block, &se.pre);
    4381                 :         116 :       detach = se.expr;
    4382                 :         116 :       gfc_add_block_to_block (block, &se.post);
    4383                 :             : 
    4384                 :         116 :       c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_DETACH);
    4385                 :         116 :       TREE_ADDRESSABLE (detach) = 1;
    4386                 :         116 :       OMP_CLAUSE_DECL (c) = detach;
    4387                 :         116 :       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
    4388                 :             :     }
    4389                 :             : 
    4390                 :       28074 :   if (clauses->filter)
    4391                 :             :     {
    4392                 :          31 :       tree filter;
    4393                 :             : 
    4394                 :          31 :       gfc_init_se (&se, NULL);
    4395                 :          31 :       gfc_conv_expr (&se, clauses->filter);
    4396                 :          31 :       gfc_add_block_to_block (block, &se.pre);
    4397                 :          31 :       filter = gfc_evaluate_now (se.expr, block);
    4398                 :          31 :       gfc_add_block_to_block (block, &se.post);
    4399                 :             : 
    4400                 :          31 :       c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_FILTER);
    4401                 :          31 :       OMP_CLAUSE_FILTER_EXPR (c) = filter;
    4402                 :          31 :       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
    4403                 :             :     }
    4404                 :             : 
    4405                 :       28074 :   if (clauses->hint)
    4406                 :             :     {
    4407                 :           8 :       tree hint;
    4408                 :             : 
    4409                 :           8 :       gfc_init_se (&se, NULL);
    4410                 :           8 :       gfc_conv_expr (&se, clauses->hint);
    4411                 :           8 :       gfc_add_block_to_block (block, &se.pre);
    4412                 :           8 :       hint = gfc_evaluate_now (se.expr, block);
    4413                 :           8 :       gfc_add_block_to_block (block, &se.post);
    4414                 :             : 
    4415                 :           8 :       c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_HINT);
    4416                 :           8 :       OMP_CLAUSE_HINT_EXPR (c) = hint;
    4417                 :           8 :       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
    4418                 :             :     }
    4419                 :             : 
    4420                 :       28074 :   if (clauses->simd)
    4421                 :             :     {
    4422                 :          22 :       c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_SIMD);
    4423                 :          22 :       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
    4424                 :             :     }
    4425                 :       28074 :   if (clauses->threads)
    4426                 :             :     {
    4427                 :          11 :       c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_THREADS);
    4428                 :          11 :       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
    4429                 :             :     }
    4430                 :       28074 :   if (clauses->nogroup)
    4431                 :             :     {
    4432                 :          13 :       c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_NOGROUP);
    4433                 :          13 :       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
    4434                 :             :     }
    4435                 :             : 
    4436                 :      196518 :   for (int i = 0; i < OMP_DEFAULTMAP_CAT_NUM; i++)
    4437                 :             :     {
    4438                 :      168444 :       if (clauses->defaultmap[i] == OMP_DEFAULTMAP_UNSET)
    4439                 :      168314 :        continue;
    4440                 :         130 :       enum omp_clause_defaultmap_kind behavior, category;
    4441                 :         130 :       switch ((gfc_omp_defaultmap_category) i)
    4442                 :             :         {
    4443                 :             :         case OMP_DEFAULTMAP_CAT_UNCATEGORIZED:
    4444                 :             :           category = OMP_CLAUSE_DEFAULTMAP_CATEGORY_UNSPECIFIED;
    4445                 :             :           break;
    4446                 :             :         case OMP_DEFAULTMAP_CAT_ALL:
    4447                 :             :           category = OMP_CLAUSE_DEFAULTMAP_CATEGORY_ALL;
    4448                 :             :           break;
    4449                 :             :         case OMP_DEFAULTMAP_CAT_SCALAR:
    4450                 :             :           category = OMP_CLAUSE_DEFAULTMAP_CATEGORY_SCALAR;
    4451                 :             :           break;
    4452                 :             :         case OMP_DEFAULTMAP_CAT_AGGREGATE:
    4453                 :             :           category = OMP_CLAUSE_DEFAULTMAP_CATEGORY_AGGREGATE;
    4454                 :             :           break;
    4455                 :             :         case OMP_DEFAULTMAP_CAT_ALLOCATABLE:
    4456                 :             :           category = OMP_CLAUSE_DEFAULTMAP_CATEGORY_ALLOCATABLE;
    4457                 :             :           break;
    4458                 :             :         case OMP_DEFAULTMAP_CAT_POINTER:
    4459                 :             :           category = OMP_CLAUSE_DEFAULTMAP_CATEGORY_POINTER;
    4460                 :             :           break;
    4461                 :             :         default: gcc_unreachable ();
    4462                 :             :         }
    4463                 :         130 :       switch (clauses->defaultmap[i])
    4464                 :             :         {
    4465                 :             :         case OMP_DEFAULTMAP_ALLOC:
    4466                 :             :           behavior = OMP_CLAUSE_DEFAULTMAP_ALLOC;
    4467                 :             :           break;
    4468                 :             :         case OMP_DEFAULTMAP_TO: behavior = OMP_CLAUSE_DEFAULTMAP_TO; break;
    4469                 :             :         case OMP_DEFAULTMAP_FROM: behavior = OMP_CLAUSE_DEFAULTMAP_FROM; break;
    4470                 :             :         case OMP_DEFAULTMAP_TOFROM:
    4471                 :             :           behavior = OMP_CLAUSE_DEFAULTMAP_TOFROM;
    4472                 :             :           break;
    4473                 :             :         case OMP_DEFAULTMAP_FIRSTPRIVATE:
    4474                 :             :           behavior = OMP_CLAUSE_DEFAULTMAP_FIRSTPRIVATE;
    4475                 :             :           break;
    4476                 :             :         case OMP_DEFAULTMAP_PRESENT:
    4477                 :             :           behavior = OMP_CLAUSE_DEFAULTMAP_PRESENT;
    4478                 :             :           break;
    4479                 :             :         case OMP_DEFAULTMAP_NONE: behavior = OMP_CLAUSE_DEFAULTMAP_NONE; break;
    4480                 :             :         case OMP_DEFAULTMAP_DEFAULT:
    4481                 :             :           behavior = OMP_CLAUSE_DEFAULTMAP_DEFAULT;
    4482                 :             :           break;
    4483                 :           0 :         default: gcc_unreachable ();
    4484                 :             :         }
    4485                 :         130 :       c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_DEFAULTMAP);
    4486                 :         130 :       OMP_CLAUSE_DEFAULTMAP_SET_KIND (c, behavior, category);
    4487                 :         130 :       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
    4488                 :             :     }
    4489                 :             : 
    4490                 :       28074 :   if (clauses->doacross_source)
    4491                 :             :     {
    4492                 :         131 :       c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_DOACROSS);
    4493                 :         131 :       OMP_CLAUSE_DOACROSS_KIND (c) = OMP_CLAUSE_DOACROSS_SOURCE;
    4494                 :         131 :       OMP_CLAUSE_DOACROSS_DEPEND (c) = clauses->depend_source;
    4495                 :         131 :       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
    4496                 :             :     }
    4497                 :             : 
    4498                 :       28074 :   if (clauses->async)
    4499                 :             :     {
    4500                 :         539 :       c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_ASYNC);
    4501                 :         539 :       if (clauses->async_expr)
    4502                 :         539 :         OMP_CLAUSE_ASYNC_EXPR (c)
    4503                 :        1078 :           = gfc_convert_expr_to_tree (block, clauses->async_expr);
    4504                 :             :       else
    4505                 :           0 :         OMP_CLAUSE_ASYNC_EXPR (c) = NULL;
    4506                 :         539 :       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
    4507                 :             :     }
    4508                 :       28074 :   if (clauses->seq)
    4509                 :             :     {
    4510                 :         113 :       c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_SEQ);
    4511                 :         113 :       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
    4512                 :             :     }
    4513                 :       28074 :   if (clauses->par_auto)
    4514                 :             :     {
    4515                 :          46 :       c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_AUTO);
    4516                 :          46 :       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
    4517                 :             :     }
    4518                 :       28074 :   if (clauses->if_present)
    4519                 :             :     {
    4520                 :          23 :       c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_IF_PRESENT);
    4521                 :          23 :       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
    4522                 :             :     }
    4523                 :       28074 :   if (clauses->finalize)
    4524                 :             :     {
    4525                 :          13 :       c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_FINALIZE);
    4526                 :          13 :       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
    4527                 :             :     }
    4528                 :       28074 :   if (clauses->independent)
    4529                 :             :     {
    4530                 :         184 :       c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_INDEPENDENT);
    4531                 :         184 :       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
    4532                 :             :     }
    4533                 :       28074 :   if (clauses->wait_list)
    4534                 :             :     {
    4535                 :             :       gfc_expr_list *el;
    4536                 :             : 
    4537                 :         317 :       for (el = clauses->wait_list; el; el = el->next)
    4538                 :             :         {
    4539                 :         172 :           c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_WAIT);
    4540                 :         172 :           OMP_CLAUSE_DECL (c) = gfc_convert_expr_to_tree (block, el->expr);
    4541                 :         172 :           OMP_CLAUSE_CHAIN (c) = omp_clauses;
    4542                 :         172 :           omp_clauses = c;
    4543                 :             :         }
    4544                 :             :     }
    4545                 :       28074 :   if (clauses->num_gangs_expr)
    4546                 :             :     {
    4547                 :         666 :       tree num_gangs_var
    4548                 :         666 :         = gfc_convert_expr_to_tree (block, clauses->num_gangs_expr);
    4549                 :         666 :       c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_NUM_GANGS);
    4550                 :         666 :       OMP_CLAUSE_NUM_GANGS_EXPR (c) = num_gangs_var;
    4551                 :         666 :       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
    4552                 :             :     }
    4553                 :       28074 :   if (clauses->num_workers_expr)
    4554                 :             :     {
    4555                 :         583 :       tree num_workers_var
    4556                 :         583 :         = gfc_convert_expr_to_tree (block, clauses->num_workers_expr);
    4557                 :         583 :       c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_NUM_WORKERS);
    4558                 :         583 :       OMP_CLAUSE_NUM_WORKERS_EXPR (c) = num_workers_var;
    4559                 :         583 :       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
    4560                 :             :     }
    4561                 :       28074 :   if (clauses->vector_length_expr)
    4562                 :             :     {
    4563                 :         553 :       tree vector_length_var
    4564                 :         553 :         = gfc_convert_expr_to_tree (block, clauses->vector_length_expr);
    4565                 :         553 :       c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_VECTOR_LENGTH);
    4566                 :         553 :       OMP_CLAUSE_VECTOR_LENGTH_EXPR (c) = vector_length_var;
    4567                 :         553 :       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
    4568                 :             :     }
    4569                 :       28074 :   if (clauses->tile_list)
    4570                 :             :     {
    4571                 :          59 :       vec<tree, va_gc> *tvec;
    4572                 :          59 :       gfc_expr_list *el;
    4573                 :             : 
    4574                 :          59 :       vec_alloc (tvec, 4);
    4575                 :             : 
    4576                 :         171 :       for (el = clauses->tile_list; el; el = el->next)
    4577                 :         112 :         vec_safe_push (tvec, gfc_convert_expr_to_tree (block, el->expr));
    4578                 :             : 
    4579                 :          59 :       c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_TILE);
    4580                 :          59 :       OMP_CLAUSE_TILE_LIST (c) = build_tree_list_vec (tvec);
    4581                 :          59 :       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
    4582                 :          59 :       tvec->truncate (0);
    4583                 :             :     }
    4584                 :       28074 :   if (clauses->vector)
    4585                 :             :     {
    4586                 :         791 :       c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_VECTOR);
    4587                 :         791 :       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
    4588                 :             : 
    4589                 :         791 :       if (clauses->vector_expr)
    4590                 :             :         {
    4591                 :         115 :           tree vector_var
    4592                 :         115 :             = gfc_convert_expr_to_tree (block, clauses->vector_expr);
    4593                 :         115 :           OMP_CLAUSE_VECTOR_EXPR (c) = vector_var;
    4594                 :             : 
    4595                 :             :           /* TODO: We're not capturing location information for individual
    4596                 :             :              clauses.  However, if we have an expression attached to the
    4597                 :             :              clause, that one provides better location information.  */
    4598                 :         230 :           OMP_CLAUSE_LOCATION (c)
    4599                 :         115 :             = gfc_get_location (&clauses->vector_expr->where);
    4600                 :             :         }
    4601                 :             :     }
    4602                 :       28074 :   if (clauses->worker)
    4603                 :             :     {
    4604                 :         685 :       c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_WORKER);
    4605                 :         685 :       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
    4606                 :             : 
    4607                 :         685 :       if (clauses->worker_expr)
    4608                 :             :         {
    4609                 :          85 :           tree worker_var
    4610                 :          85 :             = gfc_convert_expr_to_tree (block, clauses->worker_expr);
    4611                 :          85 :           OMP_CLAUSE_WORKER_EXPR (c) = worker_var;
    4612                 :             : 
    4613                 :             :           /* TODO: We're not capturing location information for individual
    4614                 :             :              clauses.  However, if we have an expression attached to the
    4615                 :             :              clause, that one provides better location information.  */
    4616                 :         170 :           OMP_CLAUSE_LOCATION (c)
    4617                 :          85 :             = gfc_get_location (&clauses->worker_expr->where);
    4618                 :             :         }
    4619                 :             :     }
    4620                 :       28074 :   if (clauses->gang)
    4621                 :             :     {
    4622                 :         951 :       tree arg;
    4623                 :         951 :       c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_GANG);
    4624                 :         951 :       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
    4625                 :             : 
    4626                 :         951 :       if (clauses->gang_num_expr)
    4627                 :             :         {
    4628                 :          97 :           arg = gfc_convert_expr_to_tree (block, clauses->gang_num_expr);
    4629                 :          97 :           OMP_CLAUSE_GANG_EXPR (c) = arg;
    4630                 :             : 
    4631                 :             :           /* TODO: We're not capturing location information for individual
    4632                 :             :              clauses.  However, if we have an expression attached to the
    4633                 :             :              clause, that one provides better location information.  */
    4634                 :         194 :           OMP_CLAUSE_LOCATION (c)
    4635                 :          97 :             = gfc_get_location (&clauses->gang_num_expr->where);
    4636                 :             :         }
    4637                 :             : 
    4638                 :         951 :       if (clauses->gang_static)
    4639                 :             :         {
    4640                 :         190 :           arg = clauses->gang_static_expr
    4641                 :          95 :             ? gfc_convert_expr_to_tree (block, clauses->gang_static_expr)
    4642                 :             :             : integer_minus_one_node;
    4643                 :          95 :           OMP_CLAUSE_GANG_STATIC_EXPR (c) = arg;
    4644                 :             :         }
    4645                 :             :     }
    4646                 :       28074 :   if (clauses->bind != OMP_BIND_UNSET)
    4647                 :             :     {
    4648                 :          30 :       c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_BIND);
    4649                 :          30 :       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
    4650                 :          30 :       switch (clauses->bind)
    4651                 :             :         {
    4652                 :          10 :         case OMP_BIND_TEAMS:
    4653                 :          10 :           OMP_CLAUSE_BIND_KIND (c) = OMP_CLAUSE_BIND_TEAMS;
    4654                 :          10 :           break;
    4655                 :          15 :         case OMP_BIND_PARALLEL:
    4656                 :          15 :           OMP_CLAUSE_BIND_KIND (c) = OMP_CLAUSE_BIND_PARALLEL;
    4657                 :          15 :           break;
    4658                 :           5 :         case OMP_BIND_THREAD:
    4659                 :           5 :           OMP_CLAUSE_BIND_KIND (c) = OMP_CLAUSE_BIND_THREAD;
    4660                 :           5 :           break;
    4661                 :           0 :         default:
    4662                 :           0 :           gcc_unreachable ();
    4663                 :             :         }
    4664                 :             :     }
    4665                 :             :   /* OpenACC 'nohost' clauses cannot appear here.  */
    4666                 :       28074 :   gcc_checking_assert (!clauses->nohost);
    4667                 :             : 
    4668                 :       28074 :   return nreverse (omp_clauses);
    4669                 :             : }
    4670                 :             : 
    4671                 :             : /* Like gfc_trans_code, but force creation of a BIND_EXPR around it.  */
    4672                 :             : 
    4673                 :             : static tree
    4674                 :       18768 : gfc_trans_omp_code (gfc_code *code, bool force_empty)
    4675                 :             : {
    4676                 :       18768 :   tree stmt;
    4677                 :             : 
    4678                 :       18768 :   pushlevel ();
    4679                 :       18768 :   stmt = gfc_trans_code (code);
    4680                 :       18768 :   if (TREE_CODE (stmt) != BIND_EXPR)
    4681                 :             :     {
    4682                 :       16743 :       if (!IS_EMPTY_STMT (stmt) || force_empty)
    4683                 :             :         {
    4684                 :       16654 :           tree block = poplevel (1, 0);
    4685                 :       16654 :           stmt = build3_v (BIND_EXPR, NULL, stmt, block);
    4686                 :             :         }
    4687                 :             :       else
    4688                 :          89 :         poplevel (0, 0);
    4689                 :             :     }
    4690                 :             :   else
    4691                 :        2025 :     poplevel (0, 0);
    4692                 :       18768 :   return stmt;
    4693                 :             : }
    4694                 :             : 
    4695                 :             : /* Translate OpenACC 'parallel', 'kernels', 'serial', 'data', 'host_data'
    4696                 :             :    construct. */
    4697                 :             : 
    4698                 :             : static tree
    4699                 :        3773 : gfc_trans_oacc_construct (gfc_code *code)
    4700                 :             : {
    4701                 :        3773 :   stmtblock_t block;
    4702                 :        3773 :   tree stmt, oacc_clauses;
    4703                 :        3773 :   enum tree_code construct_code;
    4704                 :             : 
    4705                 :        3773 :   switch (code->op)
    4706                 :             :     {
    4707                 :             :       case EXEC_OACC_PARALLEL:
    4708                 :             :         construct_code = OACC_PARALLEL;
    4709                 :             :         break;
    4710                 :             :       case EXEC_OACC_KERNELS:
    4711                 :             :         construct_code = OACC_KERNELS;
    4712                 :             :         break;
    4713                 :             :       case EXEC_OACC_SERIAL:
    4714                 :             :         construct_code = OACC_SERIAL;
    4715                 :             :         break;
    4716                 :             :       case EXEC_OACC_DATA:
    4717                 :             :         construct_code = OACC_DATA;
    4718                 :             :         break;
    4719                 :             :       case EXEC_OACC_HOST_DATA:
    4720                 :             :         construct_code = OACC_HOST_DATA;
    4721                 :             :         break;
    4722                 :           0 :       default:
    4723                 :           0 :         gcc_unreachable ();
    4724                 :             :     }
    4725                 :             : 
    4726                 :        3773 :   gfc_start_block (&block);
    4727                 :        3773 :   oacc_clauses = gfc_trans_omp_clauses (&block, code->ext.omp_clauses,
    4728                 :             :                                         code->loc, false, true);
    4729                 :        3773 :   pushlevel ();
    4730                 :        3773 :   stmt = gfc_trans_omp_code (code->block->next, true);
    4731                 :        3773 :   stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0));
    4732                 :        3773 :   stmt = build2_loc (gfc_get_location (&code->loc), construct_code,
    4733                 :             :                      void_type_node, stmt, oacc_clauses);
    4734                 :        3773 :   gfc_add_expr_to_block (&block, stmt);
    4735                 :        3773 :   return gfc_finish_block (&block);
    4736                 :             : }
    4737                 :             : 
    4738                 :             : /* update, enter_data, exit_data, cache. */
    4739                 :             : static tree 
    4740                 :        1833 : gfc_trans_oacc_executable_directive (gfc_code *code)
    4741                 :             : {
    4742                 :        1833 :   stmtblock_t block;
    4743                 :        1833 :   tree stmt, oacc_clauses;
    4744                 :        1833 :   enum tree_code construct_code;
    4745                 :             : 
    4746                 :        1833 :   switch (code->op)
    4747                 :             :     {
    4748                 :             :       case EXEC_OACC_UPDATE:
    4749                 :             :         construct_code = OACC_UPDATE;
    4750                 :             :         break;
    4751                 :         689 :       case EXEC_OACC_ENTER_DATA:
    4752                 :         689 :         construct_code = OACC_ENTER_DATA;
    4753                 :         689 :         break;
    4754                 :         469 :       case EXEC_OACC_EXIT_DATA:
    4755                 :         469 :         construct_code = OACC_EXIT_DATA;
    4756                 :         469 :         break;
    4757                 :          58 :       case EXEC_OACC_CACHE:
    4758                 :          58 :         construct_code = OACC_CACHE;
    4759                 :          58 :         break;
    4760                 :           0 :       default:
    4761                 :           0 :         gcc_unreachable ();
    4762                 :             :     }
    4763                 :             : 
    4764                 :        1833 :   gfc_start_block (&block);
    4765                 :        1833 :   oacc_clauses = gfc_trans_omp_clauses (&block, code->ext.omp_clauses,
    4766                 :             :                                         code->loc, false, true);
    4767                 :        1833 :   stmt = build1_loc (input_location, construct_code, void_type_node, 
    4768                 :             :                      oacc_clauses);
    4769                 :        1833 :   gfc_add_expr_to_block (&block, stmt);
    4770                 :        1833 :   return gfc_finish_block (&block);
    4771                 :             : }
    4772                 :             : 
    4773                 :             : static tree
    4774                 :         167 : gfc_trans_oacc_wait_directive (gfc_code *code)
    4775                 :             : {
    4776                 :         167 :   stmtblock_t block;
    4777                 :         167 :   tree stmt, t;
    4778                 :         167 :   vec<tree, va_gc> *args;
    4779                 :         167 :   int nparms = 0;
    4780                 :         167 :   gfc_expr_list *el;
    4781                 :         167 :   gfc_omp_clauses *clauses = code->ext.omp_clauses;
    4782                 :         167 :   location_t loc = input_location;
    4783                 :             : 
    4784                 :         291 :   for (el = clauses->wait_list; el; el = el->next)
    4785                 :         124 :     nparms++;
    4786                 :             : 
    4787                 :         167 :   vec_alloc (args, nparms + 2);
    4788                 :         167 :   stmt = builtin_decl_explicit (BUILT_IN_GOACC_WAIT);
    4789                 :             : 
    4790                 :         167 :   gfc_start_block (&block);
    4791                 :             : 
    4792                 :         167 :   if (clauses->async_expr)
    4793                 :           0 :     t = gfc_convert_expr_to_tree (&block, clauses->async_expr);
    4794                 :             :   else
    4795                 :         167 :     t = build_int_cst (integer_type_node, -2);
    4796                 :             : 
    4797                 :         167 :   args->quick_push (t);
    4798                 :         167 :   args->quick_push (build_int_cst (integer_type_node, nparms));
    4799                 :             : 
    4800                 :         291 :   for (el = clauses->wait_list; el; el = el->next)
    4801                 :         124 :     args->quick_push (gfc_convert_expr_to_tree (&block, el->expr));
    4802                 :             : 
    4803                 :         167 :   stmt = build_call_expr_loc_vec (loc, stmt, args);
    4804                 :         167 :   gfc_add_expr_to_block (&block, stmt);
    4805                 :             : 
    4806                 :         167 :   vec_free (args);
    4807                 :             : 
    4808                 :         167 :   return gfc_finish_block (&block);
    4809                 :             : }
    4810                 :             : 
    4811                 :             : static tree gfc_trans_omp_sections (gfc_code *, gfc_omp_clauses *);
    4812                 :             : static tree gfc_trans_omp_workshare (gfc_code *, gfc_omp_clauses *);
    4813                 :             : 
    4814                 :             : static tree
    4815                 :          10 : gfc_trans_omp_assume (gfc_code *code)
    4816                 :             : {
    4817                 :          10 :   stmtblock_t block;
    4818                 :          10 :   gfc_init_block (&block);
    4819                 :          10 :   gfc_omp_assumptions *assume = code->ext.omp_clauses->assume;
    4820                 :          10 :   if (assume)
    4821                 :          19 :     for (gfc_expr_list *el = assume->holds; el; el = el->next)
    4822                 :             :       {
    4823                 :           9 :         location_t loc = gfc_get_location (&el->expr->where);
    4824                 :           9 :         gfc_se se;
    4825                 :           9 :         gfc_init_se (&se, NULL);
    4826                 :           9 :         gfc_conv_expr (&se, el->expr);
    4827                 :           9 :         tree t;
    4828                 :           9 :         if (se.pre.head == NULL_TREE && se.post.head == NULL_TREE)
    4829                 :           8 :           t = se.expr;
    4830                 :             :         else
    4831                 :             :           {
    4832                 :           1 :             tree var = create_tmp_var_raw (boolean_type_node);
    4833                 :           1 :             DECL_CONTEXT (var) = current_function_decl;
    4834                 :           1 :             stmtblock_t block2;
    4835                 :           1 :             gfc_init_block (&block2);
    4836                 :           1 :             gfc_add_block_to_block (&block2, &se.pre);
    4837                 :           1 :             gfc_add_modify_loc (loc, &block2, var,
    4838                 :             :                                 fold_convert_loc (loc, boolean_type_node,
    4839                 :             :                                                   se.expr));
    4840                 :           1 :             gfc_add_block_to_block (&block2, &se.post);
    4841                 :           1 :             t = gfc_finish_block (&block2);
    4842                 :           1 :             t = build4 (TARGET_EXPR, boolean_type_node, var, t, NULL, NULL);
    4843                 :             :           }
    4844                 :           9 :         t = build_call_expr_internal_loc (loc, IFN_ASSUME,
    4845                 :             :                                           void_type_node, 1, t);
    4846                 :           9 :         gfc_add_expr_to_block (&block, t);
    4847                 :             :       }
    4848                 :          10 :   gfc_add_expr_to_block (&block, gfc_trans_omp_code (code->block->next, true));
    4849                 :          10 :   return gfc_finish_block (&block);
    4850                 :             : }
    4851                 :             : 
    4852                 :             : static tree
    4853                 :        2581 : gfc_trans_omp_atomic (gfc_code *code)
    4854                 :             : {
    4855                 :        2581 :   gfc_code *atomic_code = code->block;
    4856                 :        2581 :   gfc_se lse;
    4857                 :        2581 :   gfc_se rse;
    4858                 :        2581 :   gfc_se vse;
    4859                 :        2581 :   gfc_expr *expr1, *expr2, *e, *capture_expr1 = NULL, *capture_expr2 = NULL;
    4860                 :        2581 :   gfc_symbol *var;
    4861                 :        2581 :   stmtblock_t block;
    4862                 :        2581 :   tree lhsaddr, type, rhs, x, compare = NULL_TREE, comp_tgt = NULL_TREE;
    4863                 :        2581 :   enum tree_code op = ERROR_MARK;
    4864                 :        2581 :   enum tree_code aop = OMP_ATOMIC;
    4865                 :        2581 :   bool var_on_left = false, else_branch = false;
    4866                 :        2581 :   enum omp_memory_order mo, fail_mo;
    4867                 :        2581 :   switch (atomic_code->ext.omp_clauses->memorder)
    4868                 :             :     {
    4869                 :             :     case OMP_MEMORDER_UNSET: mo = OMP_MEMORY_ORDER_UNSPECIFIED; break;
    4870                 :             :     case OMP_MEMORDER_ACQ_REL: mo = OMP_MEMORY_ORDER_ACQ_REL; break;
    4871                 :             :     case OMP_MEMORDER_ACQUIRE: mo = OMP_MEMORY_ORDER_ACQUIRE; break;
    4872                 :             :     case OMP_MEMORDER_RELAXED: mo = OMP_MEMORY_ORDER_RELAXED; break;
    4873                 :             :     case OMP_MEMORDER_RELEASE: mo = OMP_MEMORY_ORDER_RELEASE; break;
    4874                 :             :     case OMP_MEMORDER_SEQ_CST: mo = OMP_MEMORY_ORDER_SEQ_CST; break;
    4875                 :           0 :     default: gcc_unreachable ();
    4876                 :             :     }
    4877                 :        2581 :   switch (atomic_code->ext.omp_clauses->fail)
    4878                 :             :     {
    4879                 :             :     case OMP_MEMORDER_UNSET: fail_mo = OMP_FAIL_MEMORY_ORDER_UNSPECIFIED; break;
    4880                 :          14 :     case OMP_MEMORDER_ACQUIRE: fail_mo = OMP_FAIL_MEMORY_ORDER_ACQUIRE; break;
    4881                 :          26 :     case OMP_MEMORDER_RELAXED: fail_mo = OMP_FAIL_MEMORY_ORDER_RELAXED; break;
    4882                 :           2 :     case OMP_MEMORDER_SEQ_CST: fail_mo = OMP_FAIL_MEMORY_ORDER_SEQ_CST; break;
    4883                 :           0 :     default: gcc_unreachable ();
    4884                 :             :     }
    4885                 :        2581 :   mo = (omp_memory_order) (mo | fail_mo);
    4886                 :             : 
    4887                 :        2581 :   code = code->block->next;
    4888                 :        2581 :   if (atomic_code->ext.omp_clauses->compare)
    4889                 :             :     {
    4890                 :         144 :       gfc_expr *comp_expr;
    4891                 :         144 :       if (code->op == EXEC_IF)
    4892                 :             :         {
    4893                 :         125 :           comp_expr = code->block->expr1;
    4894                 :         125 :           gcc_assert (code->block->next->op == EXEC_ASSIGN);
    4895                 :         125 :           expr1 = code->block->next->expr1;
    4896                 :         125 :           expr2 = code->block->next->expr2;
    4897                 :         125 :           if (code->block->block)
    4898                 :             :             {
    4899                 :          64 :               gcc_assert (atomic_code->ext.omp_clauses->capture
    4900                 :             :                           && code->block->block->next->op == EXEC_ASSIGN);
    4901                 :          64 :               else_branch = true;
    4902                 :          64 :               aop = OMP_ATOMIC_CAPTURE_OLD;
    4903                 :          64 :               capture_expr1 = code->block->block->next->expr1;
    4904                 :          64 :               capture_expr2 = code->block->block->next->expr2;
    4905                 :             :             }
    4906                 :          61 :           else if (atomic_code->ext.omp_clauses->capture)
    4907                 :             :             {
    4908                 :          19 :               gcc_assert (code->next->op == EXEC_ASSIGN);
    4909                 :          19 :               aop = OMP_ATOMIC_CAPTURE_NEW;
    4910                 :          19 :               capture_expr1 = code->next->expr1;
    4911                 :          19 :               capture_expr2 = code->next->expr2;
    4912                 :             :             }
    4913                 :             :         }
    4914                 :             :       else
    4915                 :             :         {
    4916                 :          19 :           gcc_assert (atomic_code->ext.omp_clauses->capture
    4917                 :             :                       && code->op == EXEC_ASSIGN
    4918                 :             :                       && code->next->op == EXEC_IF);
    4919                 :          19 :           aop = OMP_ATOMIC_CAPTURE_OLD;
    4920                 :          19 :           capture_expr1 = code->expr1;
    4921                 :          19 :           capture_expr2 = code->expr2;
    4922                 :          19 :           expr1 = code->next->block->next->expr1;
    4923                 :          19 :           expr2 = code->next->block->next->expr2;
    4924                 :          19 :           comp_expr = code->next->block->expr1;
    4925                 :             :         }
    4926                 :         144 :       gfc_init_se (&lse, NULL);
    4927                 :         144 :       gfc_conv_expr (&lse, comp_expr->value.op.op2);
    4928                 :         144 :       gfc_add_block_to_block (&block, &lse.pre);
    4929                 :         144 :       compare = lse.expr;
    4930                 :         144 :       var = expr1->symtree->n.sym;
    4931                 :             :     }
    4932                 :             :   else
    4933                 :             :     {
    4934                 :        2437 :       gcc_assert (code->op == EXEC_ASSIGN);
    4935                 :        2437 :       expr1 = code->expr1;
    4936                 :        2437 :       expr2 = code->expr2;
    4937                 :        2437 :       if (atomic_code->ext.omp_clauses->capture
    4938                 :         483 :           && (expr2->expr_type == EXPR_VARIABLE
    4939                 :         245 :               || (expr2->expr_type == EXPR_FUNCTION
    4940                 :         113 :                   && expr2->value.function.isym
    4941                 :         113 :                   && expr2->value.function.isym->id == GFC_ISYM_CONVERSION
    4942                 :          41 :                   && (expr2->value.function.actual->expr->expr_type
    4943                 :             :                       == EXPR_VARIABLE))))
    4944                 :             :         {
    4945                 :         255 :           capture_expr1 = expr1;
    4946                 :         255 :           capture_expr2 = expr2;
    4947                 :         255 :           expr1 = code->next->expr1;
    4948                 :         255 :           expr2 = code->next->expr2;
    4949                 :         255 :           aop = OMP_ATOMIC_CAPTURE_OLD;
    4950                 :             :         }
    4951                 :        2182 :       else if (atomic_code->ext.omp_clauses->capture)
    4952                 :             :         {
    4953                 :         228 :           aop = OMP_ATOMIC_CAPTURE_NEW;
    4954                 :         228 :           capture_expr1 = code->next->expr1;
    4955                 :         228 :           capture_expr2 = code->next->expr2;
    4956                 :             :         }
    4957                 :        2437 :       var = expr1->symtree->n.sym;
    4958                 :             :     }
    4959                 :             : 
    4960                 :        2581 :   gfc_init_se (&lse, NULL);
    4961                 :        2581 :   gfc_init_se (&rse, NULL);
    4962                 :        2581 :   gfc_init_se (&vse, NULL);
    4963                 :        2581 :   gfc_start_block (&block);
    4964                 :             : 
    4965                 :        2581 :   if (((atomic_code->ext.omp_clauses->atomic_op & GFC_OMP_ATOMIC_MASK)
    4966                 :             :        != GFC_OMP_ATOMIC_WRITE)
    4967                 :        2179 :       && expr2->expr_type == EXPR_FUNCTION
    4968                 :         472 :       && expr2->value.function.isym
    4969                 :         472 :       && expr2->value.function.isym->id == GFC_ISYM_CONVERSION)
    4970                 :         139 :     expr2 = expr2->value.function.actual->expr;
    4971                 :             : 
    4972                 :        2581 :   if ((atomic_code->ext.omp_clauses->atomic_op & GFC_OMP_ATOMIC_MASK)
    4973                 :             :       == GFC_OMP_ATOMIC_READ)
    4974                 :             :     {
    4975                 :         492 :       gfc_conv_expr (&vse, expr1);
    4976                 :         492 :       gfc_add_block_to_block (&block, &vse.pre);
    4977                 :             : 
    4978                 :         492 :       gfc_conv_expr (&lse, expr2);
    4979                 :         492 :       gfc_add_block_to_block (&block, &lse.pre);
    4980                 :         492 :       type = TREE_TYPE (lse.expr);
    4981                 :         492 :       lhsaddr = gfc_build_addr_expr (NULL, lse.expr);
    4982                 :             : 
    4983                 :         492 :       x = build1 (OMP_ATOMIC_READ, type, lhsaddr);
    4984                 :         492 :       OMP_ATOMIC_MEMORY_ORDER (x) = mo;
    4985                 :         492 :       x = convert (TREE_TYPE (vse.expr), x);
    4986                 :         492 :       gfc_add_modify (&block, vse.expr, x);
    4987                 :             : 
    4988                 :         492 :       gfc_add_block_to_block (&block, &lse.pre);
    4989                 :         492 :       gfc_add_block_to_block (&block, &rse.pre);
    4990                 :             : 
    4991                 :         492 :       return gfc_finish_block (&block);
    4992                 :             :     }
    4993                 :             : 
    4994                 :        2089 :   if (capture_expr2
    4995                 :         585 :       && capture_expr2->expr_type == EXPR_FUNCTION
    4996                 :          21 :       && capture_expr2->value.function.isym
    4997                 :          21 :       && capture_expr2->value.function.isym->id == GFC_ISYM_CONVERSION)
    4998                 :          21 :     capture_expr2 = capture_expr2->value.function.actual->expr;
    4999                 :         585 :   gcc_assert (!capture_expr2 || capture_expr2->expr_type == EXPR_VARIABLE);
    5000                 :             : 
    5001                 :        2089 :   if (aop == OMP_ATOMIC_CAPTURE_OLD)
    5002                 :             :     {
    5003                 :         338 :       gfc_conv_expr (&vse, capture_expr1);
    5004                 :         338 :       gfc_add_block_to_block (&block, &vse.pre);
    5005                 :         338 :       gfc_conv_expr (&lse, capture_expr2);
    5006                 :         338 :       gfc_add_block_to_block (&block, &lse.pre);
    5007                 :         338 :       gfc_init_se (&lse, NULL);
    5008                 :             :     }
    5009                 :             : 
    5010                 :        2089 :   gfc_conv_expr (&lse, expr1);
    5011                 :        2089 :   gfc_add_block_to_block (&block, &lse.pre);
    5012                 :        2089 :   type = TREE_TYPE (lse.expr);
    5013                 :        2089 :   lhsaddr = gfc_build_addr_expr (NULL, lse.expr);
    5014                 :             : 
    5015                 :        2089 :   if (((atomic_code->ext.omp_clauses->atomic_op & GFC_OMP_ATOMIC_MASK)
    5016                 :             :        == GFC_OMP_ATOMIC_WRITE)
    5017                 :        1687 :       || (atomic_code->ext.omp_clauses->atomic_op & GFC_OMP_ATOMIC_SWAP)
    5018                 :        1665 :       || compare)
    5019                 :             :     {
    5020                 :         568 :       gfc_conv_expr (&rse, expr2);
    5021                 :         568 :       gfc_add_block_to_block (&block, &rse.pre);
    5022                 :             :     }
    5023                 :        1521 :   else if (expr2->expr_type == EXPR_OP)
    5024                 :             :     {
    5025                 :        1175 :       gfc_expr *e;
    5026                 :        1175 :       switch (expr2->value.op.op)
    5027                 :             :         {
    5028                 :             :         case INTRINSIC_PLUS:
    5029                 :             :           op = PLUS_EXPR;
    5030                 :             :           break;
    5031                 :          91 :         case INTRINSIC_TIMES:
    5032                 :          91 :           op = MULT_EXPR;
    5033                 :          91 :           break;
    5034                 :         113 :         case INTRINSIC_MINUS:
    5035                 :         113 :           op = MINUS_EXPR;
    5036                 :         113 :           break;
    5037                 :          91 :         case INTRINSIC_DIVIDE:
    5038                 :          91 :           if (expr2->ts.type == BT_INTEGER)
    5039                 :             :             op = TRUNC_DIV_EXPR;
    5040                 :             :           else
    5041                 :          74 :             op = RDIV_EXPR;
    5042                 :             :           break;
    5043                 :          43 :         case INTRINSIC_AND:
    5044                 :          43 :           op = TRUTH_ANDIF_EXPR;
    5045                 :          43 :           break;
    5046                 :          49 :         case INTRINSIC_OR:
    5047                 :          49 :           op = TRUTH_ORIF_EXPR;
    5048                 :          49 :           break;
    5049                 :          43 :         case INTRINSIC_EQV:
    5050                 :          43 :           op = EQ_EXPR;
    5051                 :          43 :           break;
    5052                 :          43 :         case INTRINSIC_NEQV:
    5053                 :          43 :           op = NE_EXPR;
    5054                 :          43 :           break;
    5055                 :           0 :         default:
    5056                 :           0 :           gcc_unreachable ();
    5057                 :             :         }
    5058                 :        1175 :       e = expr2->value.op.op1;
    5059                 :        1175 :       if (e->expr_type == EXPR_FUNCTION
    5060                 :          48 :           && e->value.function.isym
    5061                 :          48 :           && e->value.function.isym->id == GFC_ISYM_CONVERSION)
    5062                 :          48 :         e = e->value.function.actual->expr;
    5063                 :        1175 :       if (e->expr_type == EXPR_VARIABLE
    5064                 :         916 :           && e->symtree != NULL
    5065                 :         916 :           && e->symtree->n.sym == var)
    5066                 :             :         {
    5067                 :         901 :           expr2 = expr2->value.op.op2;
    5068                 :         901 :           var_on_left = true;
    5069                 :             :         }
    5070                 :             :       else
    5071                 :             :         {
    5072                 :         274 :           e = expr2->value.op.op2;
    5073                 :         274 :           if (e->expr_type == EXPR_FUNCTION
    5074                 :          48 :               && e->value.function.isym
    5075                 :          48 :               && e->value.function.isym->id == GFC_ISYM_CONVERSION)
    5076                 :          48 :             e = e->value.function.actual->expr;
    5077                 :         274 :           gcc_assert (e->expr_type == EXPR_VARIABLE
    5078                 :             :                       && e->symtree != NULL
    5079                 :             :                       && e->symtree->n.sym == var);
    5080                 :             :           expr2 = expr2->value.op.op1;
    5081                 :             :           var_on_left = false;
    5082                 :             :         }
    5083                 :        1175 :       gfc_conv_expr (&rse, expr2);
    5084                 :        1175 :       gfc_add_block_to_block (&block, &rse.pre);
    5085                 :             :     }
    5086                 :             :   else
    5087                 :             :     {
    5088                 :         346 :       gcc_assert (expr2->expr_type == EXPR_FUNCTION);
    5089                 :         346 :       switch (expr2->value.function.isym->id)
    5090                 :             :         {
    5091                 :             :         case GFC_ISYM_MIN:
    5092                 :             :           op = MIN_EXPR;
    5093                 :             :           break;
    5094                 :         114 :         case GFC_ISYM_MAX:
    5095                 :         114 :           op = MAX_EXPR;
    5096                 :         114 :           break;
    5097                 :          47 :         case GFC_ISYM_IAND:
    5098                 :          47 :           op = BIT_AND_EXPR;
    5099                 :          47 :           break;
    5100                 :          49 :         case GFC_ISYM_IOR:
    5101                 :          49 :           op = BIT_IOR_EXPR;
    5102                 :          49 :           break;
    5103                 :          45 :         case GFC_ISYM_IEOR:
    5104                 :          45 :           op = BIT_XOR_EXPR;
    5105                 :          45 :           break;
    5106                 :           0 :         default:
    5107                 :           0 :           gcc_unreachable ();
    5108                 :             :         }
    5109                 :         346 :       e = expr2->value.function.actual->expr;
    5110                 :         346 :       if (e->expr_type == EXPR_FUNCTION
    5111                 :          13 :           && e->value.function.isym
    5112                 :          13 :           && e->value.function.isym->id == GFC_ISYM_CONVERSION)
    5113                 :          13 :         e = e->value.function.actual->expr;
    5114                 :         346 :       gcc_assert (e->expr_type == EXPR_VARIABLE
    5115                 :             :                   && e->symtree != NULL
    5116                 :             :                   && e->symtree->n.sym == var);
    5117                 :             : 
    5118                 :         346 :       gfc_conv_expr (&rse, expr2->value.function.actual->next->expr);
    5119                 :         346 :       gfc_add_block_to_block (&block, &rse.pre);
    5120                 :         346 :       if (expr2->value.function.actual->next->next != NULL)
    5121                 :             :         {
    5122                 :          26 :           tree accum = gfc_create_var (TREE_TYPE (rse.expr), NULL);
    5123                 :          26 :           gfc_actual_arglist *arg;
    5124                 :             : 
    5125                 :          26 :           gfc_add_modify (&block, accum, rse.expr);
    5126                 :          64 :           for (arg = expr2->value.function.actual->next->next; arg;
    5127                 :          38 :                arg = arg->next)
    5128                 :             :             {
    5129                 :          38 :               gfc_init_block (&rse.pre);
    5130                 :          38 :               gfc_conv_expr (&rse, arg->expr);
    5131                 :          38 :               gfc_add_block_to_block (&block, &rse.pre);
    5132                 :          38 :               x = fold_build2_loc (input_location, op, TREE_TYPE (accum),
    5133                 :             :                                    accum, rse.expr);
    5134                 :          38 :               gfc_add_modify (&block, accum, x);
    5135                 :             :             }
    5136                 :             : 
    5137                 :          26 :           rse.expr = accum;
    5138                 :             :         }
    5139                 :             : 
    5140                 :         346 :       expr2 = expr2->value.function.actual->next->expr;
    5141                 :             :     }
    5142                 :             : 
    5143                 :        2089 :   lhsaddr = save_expr (lhsaddr);
    5144                 :        2089 :   if (TREE_CODE (lhsaddr) != SAVE_EXPR
    5145                 :        2089 :       && (TREE_CODE (lhsaddr) != ADDR_EXPR
    5146                 :        1657 :           || !VAR_P (TREE_OPERAND (lhsaddr, 0))))
    5147                 :             :     {
    5148                 :             :       /* Make sure LHS is simple enough so that goa_lhs_expr_p can recognize
    5149                 :             :          it even after unsharing function body.  */
    5150                 :          40 :       tree var = create_tmp_var_raw (TREE_TYPE (lhsaddr));
    5151                 :          40 :       DECL_CONTEXT (var) = current_function_decl;
    5152                 :          40 :       lhsaddr = build4 (TARGET_EXPR, TREE_TYPE (lhsaddr), var, lhsaddr,
    5153                 :             :                         NULL_TREE, NULL_TREE);
    5154                 :             :     }
    5155                 :             : 
    5156                 :        2089 :   if (compare)
    5157                 :             :     {
    5158                 :         144 :       tree var = create_tmp_var_raw (TREE_TYPE (lhsaddr));
    5159                 :         144 :       DECL_CONTEXT (var) = current_function_decl;
    5160                 :         144 :       lhsaddr = build4 (TARGET_EXPR, TREE_TYPE (lhsaddr), var, lhsaddr, NULL,
    5161                 :             :                         NULL);
    5162                 :         144 :       lse.expr = build_fold_indirect_ref_loc (input_location, lhsaddr);
    5163                 :         144 :       compare = convert (TREE_TYPE (lse.expr), compare);
    5164                 :         144 :       compare = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node,
    5165                 :             :                                  lse.expr, compare);
    5166                 :             :     }
    5167                 :             : 
    5168                 :        2089 :   if (expr2->expr_type == EXPR_VARIABLE || compare)
    5169                 :         458 :     rhs = rse.expr;
    5170                 :             :   else
    5171                 :        1631 :     rhs = gfc_evaluate_now (rse.expr, &block);
    5172                 :             : 
    5173                 :        2089 :   if (((atomic_code->ext.omp_clauses->atomic_op & GFC_OMP_ATOMIC_MASK)
    5174                 :             :        == GFC_OMP_ATOMIC_WRITE)
    5175                 :        1687 :       || (atomic_code->ext.omp_clauses->atomic_op & GFC_OMP_ATOMIC_SWAP)
    5176                 :        1665 :       || compare)
    5177                 :             :     x = rhs;
    5178                 :             :   else
    5179                 :             :     {
    5180                 :        1521 :       x = convert (TREE_TYPE (rhs),
    5181                 :             :                    build_fold_indirect_ref_loc (input_location, lhsaddr));
    5182                 :        1521 :       if (var_on_left)
    5183                 :         901 :         x = fold_build2_loc (input_location, op, TREE_TYPE (rhs), x, rhs);
    5184                 :             :       else
    5185                 :         620 :         x = fold_build2_loc (input_location, op, TREE_TYPE (rhs), rhs, x);
    5186                 :             :     }
    5187                 :             : 
    5188                 :        2089 :   if (TREE_CODE (TREE_TYPE (rhs)) == COMPLEX_TYPE
    5189                 :        2089 :       && TREE_CODE (type) != COMPLEX_TYPE)
    5190                 :           0 :     x = fold_build1_loc (input_location, REALPART_EXPR,
    5191                 :           0 :                          TREE_TYPE (TREE_TYPE (rhs)), x);
    5192                 :             : 
    5193                 :        2089 :   gfc_add_block_to_block (&block, &lse.pre);
    5194                 :        2089 :   gfc_add_block_to_block (&block, &rse.pre);
    5195                 :             : 
    5196                 :        2089 :   if (aop == OMP_ATOMIC_CAPTURE_NEW)
    5197                 :             :     {
    5198                 :         247 :       gfc_conv_expr (&vse, capture_expr1);
    5199                 :         247 :       gfc_add_block_to_block (&block, &vse.pre);
    5200                 :         247 :       gfc_add_block_to_block (&block, &lse.pre);
    5201                 :             :     }
    5202                 :             : 
    5203                 :        2089 :   if (compare && else_branch)
    5204                 :             :     {
    5205                 :          64 :       tree var2 = create_tmp_var_raw (boolean_type_node);
    5206                 :          64 :       DECL_CONTEXT (var2) = current_function_decl;
    5207                 :          64 :       comp_tgt = build4 (TARGET_EXPR, boolean_type_node, var2,
    5208                 :             :                          boolean_false_node, NULL, NULL);
    5209                 :          64 :       compare = fold_build2_loc (input_location, MODIFY_EXPR, TREE_TYPE (var2),
    5210                 :             :                                  var2, compare);
    5211                 :          64 :       TREE_OPERAND (compare, 0) = comp_tgt;
    5212                 :          64 :       compare = omit_one_operand_loc (input_location, boolean_type_node,
    5213                 :             :                                       compare, comp_tgt);
    5214                 :             :     }
    5215                 :             : 
    5216                 :        2089 :   if (compare)
    5217                 :         144 :     x = build3_loc (input_location, COND_EXPR, type, compare,
    5218                 :             :                     convert (type, x), lse.expr);
    5219                 :             : 
    5220                 :        2089 :   if (aop == OMP_ATOMIC)
    5221                 :             :     {
    5222                 :        1504 :       x = build2_v (OMP_ATOMIC, lhsaddr, convert (type, x));
    5223                 :        1504 :       OMP_ATOMIC_MEMORY_ORDER (x) = mo;
    5224                 :        1504 :       OMP_ATOMIC_WEAK (x) = atomic_code->ext.omp_clauses->weak;
    5225                 :        1504 :       gfc_add_expr_to_block (&block, x);
    5226                 :             :     }
    5227                 :             :   else
    5228                 :             :     {
    5229                 :         585 :       x = build2 (aop, type, lhsaddr, convert (type, x));
    5230                 :         585 :       OMP_ATOMIC_MEMORY_ORDER (x) = mo;
    5231                 :         585 :       OMP_ATOMIC_WEAK (x) = atomic_code->ext.omp_clauses->weak;
    5232                 :         585 :       if (compare && else_branch)
    5233                 :             :         {
    5234                 :          64 :           tree vtmp = create_tmp_var_raw (TREE_TYPE (x));
    5235                 :          64 :           DECL_CONTEXT (vtmp) = current_function_decl;
    5236                 :          64 :           x = fold_build2_loc (input_location, MODIFY_EXPR,
    5237                 :          64 :                                TREE_TYPE (vtmp), vtmp, x);
    5238                 :          64 :           vtmp = build4 (TARGET_EXPR, TREE_TYPE (vtmp), vtmp,
    5239                 :          64 :                          build_zero_cst (TREE_TYPE (vtmp)), NULL, NULL);
    5240                 :          64 :           TREE_OPERAND (x, 0) = vtmp;
    5241                 :          64 :           tree x2 = convert (TREE_TYPE (vse.expr), vtmp);
    5242                 :          64 :           x2 = fold_build2_loc (input_location, MODIFY_EXPR,
    5243                 :          64 :                                TREE_TYPE (vse.expr), vse.expr, x2);
    5244                 :          64 :           x2 = build3_loc (input_location, COND_EXPR, void_type_node, comp_tgt,
    5245                 :             :                            void_node, x2);
    5246                 :          64 :           x = omit_one_operand_loc (input_location, TREE_TYPE (x2), x2, x);
    5247                 :          64 :           gfc_add_expr_to_block (&block, x);
    5248                 :             :         }
    5249                 :             :       else
    5250                 :             :         {
    5251                 :         521 :           x = convert (TREE_TYPE (vse.expr), x);
    5252                 :         521 :           gfc_add_modify (&block, vse.expr, x);
    5253                 :             :         }
    5254                 :             :     }
    5255                 :             : 
    5256                 :        2089 :   return gfc_finish_block (&block);
    5257                 :             : }
    5258                 :             : 
    5259                 :             : static tree
    5260                 :         602 : gfc_trans_omp_barrier (void)
    5261                 :             : {
    5262                 :         602 :   tree decl = builtin_decl_explicit (BUILT_IN_GOMP_BARRIER);
    5263                 :         602 :   return build_call_expr_loc (input_location, decl, 0);
    5264                 :             : }
    5265                 :             : 
    5266                 :             : static tree
    5267                 :         310 : gfc_trans_omp_cancel (gfc_code *code)
    5268                 :             : {
    5269                 :         310 :   int mask = 0;
    5270                 :         310 :   tree ifc = boolean_true_node;
    5271                 :         310 :   stmtblock_t block;
    5272                 :         310 :   switch (code->ext.omp_clauses->cancel)
    5273                 :             :     {
    5274                 :             :     case OMP_CANCEL_PARALLEL: mask = 1; break;
    5275                 :             :     case OMP_CANCEL_DO: mask = 2; break;
    5276                 :             :     case OMP_CANCEL_SECTIONS: mask = 4; break;
    5277                 :             :     case OMP_CANCEL_TASKGROUP: mask = 8; break;
    5278                 :           0 :     default: gcc_unreachable ();
    5279                 :             :     }
    5280                 :         310 :   gfc_start_block (&block);
    5281                 :         310 :   if (code->ext.omp_clauses->if_expr
    5282                 :         219 :       || code->ext.omp_clauses->if_exprs[OMP_IF_CANCEL])
    5283                 :             :     {
    5284                 :          99 :       gfc_se se;
    5285                 :          99 :       tree if_var;
    5286                 :             : 
    5287                 :          99 :       gcc_assert ((code->ext.omp_clauses->if_expr == NULL)
    5288                 :             :                   ^ (code->ext.omp_clauses->if_exprs[OMP_IF_CANCEL] == NULL));
    5289                 :          99 :       gfc_init_se (&se, NULL);
    5290                 :          99 :       gfc_conv_expr (&se, code->ext.omp_clauses->if_expr != NULL
    5291                 :             :                           ? code->ext.omp_clauses->if_expr
    5292                 :             :                           : code->ext.omp_clauses->if_exprs[OMP_IF_CANCEL]);
    5293                 :          99 :       gfc_add_block_to_block (&block, &se.pre);
    5294                 :          99 :       if_var = gfc_evaluate_now (se.expr, &block);
    5295                 :          99 :       gfc_add_block_to_block (&block, &se.post);
    5296                 :          99 :       tree type = TREE_TYPE (if_var);
    5297                 :          99 :       ifc = fold_build2_loc (input_location, NE_EXPR,
    5298                 :             :                              boolean_type_node, if_var,
    5299                 :             :                              build_zero_cst (type));
    5300                 :             :     }
    5301                 :         310 :   tree decl = builtin_decl_explicit (BUILT_IN_GOMP_CANCEL);
    5302                 :         310 :   tree c_bool_type = TREE_TYPE (TREE_TYPE (decl));
    5303                 :         310 :   ifc = fold_convert (c_bool_type, ifc);
    5304                 :         310 :   gfc_add_expr_to_block (&block,
    5305                 :             :                          build_call_expr_loc (input_location, decl, 2,
    5306                 :             :                                               build_int_cst (integer_type_node,
    5307                 :             :                                                              mask), ifc));
    5308                 :         310 :   return gfc_finish_block (&block);
    5309                 :             : }
    5310                 :             : 
    5311                 :             : static tree
    5312                 :         170 : gfc_trans_omp_cancellation_point (gfc_code *code)
    5313                 :             : {
    5314                 :         170 :   int mask = 0;
    5315                 :         170 :   switch (code->ext.omp_clauses->cancel)
    5316                 :             :     {
    5317                 :             :     case OMP_CANCEL_PARALLEL: mask = 1; break;
    5318                 :             :     case OMP_CANCEL_DO: mask = 2; break;
    5319                 :             :     case OMP_CANCEL_SECTIONS: mask = 4; break;
    5320                 :             :     case OMP_CANCEL_TASKGROUP: mask = 8; break;
    5321                 :           0 :     default: gcc_unreachable ();
    5322                 :             :     }
    5323                 :         170 :   tree decl = builtin_decl_explicit (BUILT_IN_GOMP_CANCELLATION_POINT);
    5324                 :         170 :   return build_call_expr_loc (input_location, decl, 1,
    5325                 :         170 :                               build_int_cst (integer_type_node, mask));
    5326                 :             : }
    5327                 :             : 
    5328                 :             : static tree
    5329                 :         143 : gfc_trans_omp_critical (gfc_code *code)
    5330                 :             : {
    5331                 :         143 :   stmtblock_t block;
    5332                 :         143 :   tree stmt, name = NULL_TREE;
    5333                 :         143 :   if (code->ext.omp_clauses->critical_name != NULL)
    5334                 :          36 :     name = get_identifier (code->ext.omp_clauses->critical_name);
    5335                 :         143 :   gfc_start_block (&block);
    5336                 :         143 :   stmt = make_node (OMP_CRITICAL);
    5337                 :         143 :   SET_EXPR_LOCATION (stmt, gfc_get_location (&code->loc));
    5338                 :         143 :   TREE_TYPE (stmt) = void_type_node;
    5339                 :         143 :   OMP_CRITICAL_BODY (stmt) = gfc_trans_code (code->block->next);
    5340                 :         143 :   OMP_CRITICAL_NAME (stmt) = name;
    5341                 :         143 :   OMP_CRITICAL_CLAUSES (stmt) = gfc_trans_omp_clauses (&block,
    5342                 :             :                                                        code->ext.omp_clauses,
    5343                 :             :                                                        code->loc);
    5344                 :         143 :   gfc_add_expr_to_block (&block, stmt);
    5345                 :         143 :   return gfc_finish_block (&block);
    5346                 :             : }
    5347                 :             : 
    5348                 :             : typedef struct dovar_init_d {
    5349                 :             :   gfc_symbol *sym;
    5350                 :             :   tree var;
    5351                 :             :   tree init;
    5352                 :             :   bool non_unit_iter;
    5353                 :             : } dovar_init;
    5354                 :             : 
    5355                 :             : static bool
    5356                 :        2856 : gfc_nonrect_loop_expr (stmtblock_t *pblock, gfc_se *sep, int loop_n,
    5357                 :             :                        gfc_code *code, gfc_expr *expr, vec<dovar_init> *inits,
    5358                 :             :                        int simple, gfc_expr *curr_loop_var)
    5359                 :             : {
    5360                 :        2856 :   int i;
    5361                 :        4724 :   for (i = 0; i < loop_n; i++)
    5362                 :             :     {
    5363                 :        2417 :       gcc_assert (code->ext.iterator->var->expr_type == EXPR_VARIABLE);
    5364                 :        2417 :       if (gfc_find_sym_in_expr (code->ext.iterator->var->symtree->n.sym, expr))
    5365                 :             :         break;
    5366                 :        1868 :       code = code->block->next;
    5367                 :             :     }
    5368                 :        2856 :   if (i >= loop_n)
    5369                 :             :     return false;
    5370                 :             : 
    5371                 :             :   /* Canonical format: TREE_VEC with [var, multiplier, offset].  */
    5372                 :         549 :   gfc_symbol *var = code->ext.iterator->var->symtree->n.sym;
    5373                 :             : 
    5374                 :         549 :   tree tree_var = NULL_TREE;
    5375                 :         549 :   tree a1 = integer_one_node;
    5376                 :         549 :   tree a2 = integer_zero_node;
    5377                 :             : 
    5378                 :         549 :   if (!simple)
    5379                 :             :     {
    5380                 :             :       /* FIXME: Handle non-const iter steps, cf. PR fortran/110735.  */
    5381                 :           6 :       sorry_at (gfc_get_location (&curr_loop_var->where),
    5382                 :             :                 "non-rectangular loop nest with non-constant step for %qs",
    5383                 :           3 :                 curr_loop_var->symtree->n.sym->name);
    5384                 :           3 :       return false;
    5385                 :             :     }
    5386                 :             : 
    5387                 :             :   dovar_init *di;
    5388                 :             :   unsigned ix;
    5389                 :         546 :   FOR_EACH_VEC_ELT (*inits, ix, di)
    5390                 :          18 :     if (di->sym == var)
    5391                 :             :       {
    5392                 :          18 :         if (!di->non_unit_iter)
    5393                 :             :           {
    5394                 :          16 :             tree_var = di->init;
    5395                 :          16 :             gcc_assert (DECL_P (tree_var));
    5396                 :             :             break;
    5397                 :             :           }
    5398                 :             :         else
    5399                 :             :           {
    5400                 :             :             /* FIXME: Handle non-const iter steps, cf. PR fortran/110735.  */
    5401                 :           2 :             sorry_at (gfc_get_location (&code->loc),
    5402                 :             :                       "non-rectangular loop nest with non-constant step "
    5403                 :             :                       "for %qs", var->name);
    5404                 :           2 :             inform (gfc_get_location (&expr->where), "Used here");
    5405                 :           2 :             return false;
    5406                 :             :           }
    5407                 :             :       }
    5408                 :         528 :   if (tree_var == NULL_TREE)
    5409                 :         528 :     tree_var = var->backend_decl;
    5410                 :             : 
    5411                 :         544 :   if (expr->expr_type == EXPR_VARIABLE)
    5412                 :          49 :     gcc_assert (expr->symtree->n.sym == var);
    5413                 :         495 :   else if (expr->expr_type != EXPR_OP
    5414                 :         495 :            || (expr->value.op.op != INTRINSIC_TIMES
    5415                 :         479 :                && expr->value.op.op != INTRINSIC_PLUS
    5416                 :         359 :                && expr->value.op.op != INTRINSIC_MINUS))
    5417                 :           0 :     gcc_unreachable ();
    5418                 :             :   else
    5419                 :             :     {
    5420                 :         495 :       gfc_se se;
    5421                 :         495 :       gfc_expr *et = NULL, *eo = NULL, *e = expr;
    5422                 :         495 :       if (expr->value.op.op != INTRINSIC_TIMES)
    5423                 :             :         {
    5424                 :         479 :           if (gfc_find_sym_in_expr (var, expr->value.op.op1))
    5425                 :             :             {
    5426                 :         431 :               e = expr->value.op.op1;
    5427                 :         431 :               eo = expr->value.op.op2;
    5428                 :             :             }
    5429                 :             :           else
    5430                 :             :             {
    5431                 :          48 :               eo = expr->value.op.op1;
    5432                 :          48 :               e = expr->value.op.op2;
    5433                 :             :             }
    5434                 :             :         }
    5435                 :         495 :       if (e->value.op.op == INTRINSIC_TIMES)
    5436                 :             :         {
    5437                 :          91 :           if (e->value.op.op1->expr_type == EXPR_VARIABLE
    5438                 :          91 :               && e->value.op.op1->symtree->n.sym == var)
    5439                 :          51 :             et = e->value.op.op2;
    5440                 :             :           else
    5441                 :             :             {
    5442                 :          40 :               et = e->value.op.op1;
    5443                 :          40 :               gcc_assert (e->value.op.op2->expr_type == EXPR_VARIABLE
    5444                 :             :                           && e->value.op.op2->symtree->n.sym == var);
    5445                 :             :             }
    5446                 :             :         }
    5447                 :             :       else
    5448                 :         404 :         gcc_assert (e->expr_type == EXPR_VARIABLE && e->symtree->n.sym == var);
    5449                 :          91 :       if (et != NULL)
    5450                 :             :         {
    5451                 :          91 :           gfc_init_se (&se, NULL);
    5452                 :          91 :           gfc_conv_expr_val (&se, et);
    5453                 :          91 :           gfc_add_block_to_block (pblock, &se.pre);
    5454                 :          91 :           a1 = se.expr;
    5455                 :             :         }
    5456                 :         495 :       if (eo != NULL)
    5457                 :             :         {
    5458                 :         479 :           gfc_init_se (&se, NULL);
    5459                 :         479 :           gfc_conv_expr_val (&se, eo);
    5460                 :         479 :           gfc_add_block_to_block (pblock, &se.pre);
    5461                 :         479 :           a2 = se.expr;
    5462                 :         479 :           if (expr->value.op.op == INTRINSIC_MINUS && expr->value.op.op2 == eo)
    5463                 :             :             /* outer-var - a2.  */
    5464                 :         335 :             a2 = fold_build1 (NEGATE_EXPR, TREE_TYPE (a2), a2);
    5465                 :         144 :           else if (expr->value.op.op == INTRINSIC_MINUS)
    5466                 :             :             /* a2 - outer-var.  */
    5467                 :          24 :             a1 = fold_build1 (NEGATE_EXPR, TREE_TYPE (a1), a1);
    5468                 :             :         }
    5469                 :         495 :       a1 = DECL_P (a1) ? a1 : gfc_evaluate_now (a1, pblock);
    5470                 :         495 :       a2 = DECL_P (a2) ? a2 : gfc_evaluate_now (a2, pblock);
    5471                 :             :     }
    5472                 :             : 
    5473                 :         544 :   gfc_init_se (sep, NULL);
    5474                 :         544 :   sep->expr = make_tree_vec (3);
    5475                 :         544 :   TREE_VEC_ELT (sep->expr, 0) = tree_var;
    5476                 :         544 :   TREE_VEC_ELT (sep->expr, 1) = fold_convert (TREE_TYPE (tree_var), a1);
    5477                 :         544 :   TREE_VEC_ELT (sep->expr, 2) = fold_convert (TREE_TYPE (tree_var), a2);
    5478                 :             : 
    5479                 :         544 :   return true;
    5480                 :             : }
    5481                 :             : 
    5482                 :             : static tree
    5483                 :        8227 : gfc_trans_omp_do (gfc_code *code, gfc_exec_op op, stmtblock_t *pblock,
    5484                 :             :                   gfc_omp_clauses *do_clauses, tree par_clauses)
    5485                 :             : {
    5486                 :        8227 :   gfc_se se;
    5487                 :        8227 :   tree dovar, stmt, from, to, step, type, init, cond, incr, orig_decls;
    5488                 :        8227 :   tree local_dovar = NULL_TREE, cycle_label, tmp, omp_clauses;
    5489                 :        8227 :   stmtblock_t block;
    5490                 :        8227 :   stmtblock_t body;
    5491                 :        8227 :   gfc_omp_clauses *clauses = code->ext.omp_clauses;
    5492                 :        8227 :   int i, collapse = clauses->collapse;
    5493                 :        8227 :   vec<dovar_init> inits = vNULL;
    5494                 :        8227 :   dovar_init *di;
    5495                 :        8227 :   unsigned ix;
    5496                 :        8227 :   vec<tree, va_heap, vl_embed> *saved_doacross_steps = doacross_steps;
    5497                 :        8227 :   gfc_expr_list *tile = do_clauses ? do_clauses->tile_list : clauses->tile_list;
    5498                 :        8227 :   gfc_code *orig_code = code;
    5499                 :             : 
    5500                 :             :   /* Both collapsed and tiled loops are lowered the same way.  In
    5501                 :             :      OpenACC, those clauses are not compatible, so prioritize the tile
    5502                 :             :      clause, if present.  */
    5503                 :        8227 :   if (tile)
    5504                 :             :     {
    5505                 :             :       collapse = 0;
    5506                 :         171 :       for (gfc_expr_list *el = tile; el; el = el->next)
    5507                 :         112 :         collapse++;
    5508                 :             :     }
    5509                 :             : 
    5510                 :        8227 :   doacross_steps = NULL;
    5511                 :        8227 :   if (clauses->orderedc)
    5512                 :         131 :     collapse = clauses->orderedc;
    5513                 :        8227 :   if (collapse <= 0)
    5514                 :             :     collapse = 1;
    5515                 :             : 
    5516                 :        8227 :   code = code->block->next;
    5517                 :        8227 :   gcc_assert (code->op == EXEC_DO);
    5518                 :             : 
    5519                 :        8227 :   init = make_tree_vec (collapse);
    5520                 :        8227 :   cond = make_tree_vec (collapse);
    5521                 :        8227 :   incr = make_tree_vec (collapse);
    5522                 :        8227 :   orig_decls = clauses->ordered ? make_tree_vec (collapse) : NULL_TREE;
    5523                 :             : 
    5524                 :        8227 :   if (pblock == NULL)
    5525                 :             :     {
    5526                 :        5214 :       gfc_start_block (&block);
    5527                 :        5214 :       pblock = &block;
    5528                 :             :     }
    5529                 :             : 
    5530                 :             :   /* simd schedule modifier is only useful for composite do simd and other
    5531                 :             :      constructs including that, where gfc_trans_omp_do is only called
    5532                 :             :      on the simd construct and DO's clauses are translated elsewhere.  */
    5533                 :        8227 :   do_clauses->sched_simd = false;
    5534                 :             : 
    5535                 :        8227 :   omp_clauses = gfc_trans_omp_clauses (pblock, do_clauses, code->loc);
    5536                 :             : 
    5537                 :       18775 :   for (i = 0; i < collapse; i++)
    5538                 :             :     {
    5539                 :       10548 :       int simple = 0;
    5540                 :       10548 :       int dovar_found = 0;
    5541                 :       10548 :       tree dovar_decl;
    5542                 :             : 
    5543                 :       10548 :       if (clauses)
    5544                 :             :         {
    5545                 :       10548 :           gfc_omp_namelist *n = NULL;
    5546                 :       10548 :           if (op == EXEC_OMP_SIMD && collapse == 1)
    5547                 :         925 :             for (n = clauses->lists[OMP_LIST_LINEAR];
    5548                 :        1225 :                  n != NULL; n = n->next)
    5549                 :         443 :               if (code->ext.iterator->var->symtree->n.sym == n->sym)
    5550                 :             :                 {
    5551                 :             :                   dovar_found = 3;
    5552                 :             :                   break;
    5553                 :             :                 }
    5554                 :       10548 :           if (n == NULL && op != EXEC_OMP_DISTRIBUTE)
    5555                 :       10311 :             for (n = clauses->lists[OMP_LIST_LASTPRIVATE];
    5556                 :       12370 :                  n != NULL; n = n->next)
    5557                 :        3430 :               if (code->ext.iterator->var->symtree->n.sym == n->sym)
    5558                 :             :                 {
    5559                 :             :                   dovar_found = 2;
    5560                 :             :                   break;
    5561                 :             :                 }
    5562                 :       10548 :           if (n == NULL)
    5563                 :       10221 :             for (n = clauses->lists[OMP_LIST_PRIVATE]; n != NULL; n = n->next)
    5564                 :        6368 :               if (code->ext.iterator->var->symtree->n.sym == n->sym)
    5565                 :             :                 {
    5566                 :             :                   dovar_found = 1;
    5567                 :             :                   break;
    5568                 :             :                 }
    5569                 :             :         }
    5570                 :             : 
    5571                 :             :       /* Evaluate all the expressions in the iterator.  */
    5572                 :       10548 :       gfc_init_se (&se, NULL);
    5573                 :       10548 :       gfc_conv_expr_lhs (&se, code->ext.iterator->var);
    5574                 :       10548 :       gfc_add_block_to_block (pblock, &se.pre);
    5575                 :       10548 :       local_dovar = dovar_decl = dovar = se.expr;
    5576                 :       10548 :       type = TREE_TYPE (dovar);
    5577                 :       10548 :       gcc_assert (TREE_CODE (type) == INTEGER_TYPE);
    5578                 :             : 
    5579                 :       10548 :       gfc_init_se (&se, NULL);
    5580                 :       10548 :       gfc_conv_expr_val (&se, code->ext.iterator->step);
    5581                 :       10548 :       gfc_add_block_to_block (pblock, &se.pre);
    5582                 :       10548 :       step = gfc_evaluate_now (se.expr, pblock);
    5583                 :             : 
    5584                 :       10548 :       if (TREE_CODE (step) == INTEGER_CST)
    5585                 :        9997 :         simple = tree_int_cst_sgn (step);
    5586                 :             : 
    5587                 :       10548 :       gfc_init_se (&se, NULL);
    5588                 :       10548 :       if (!clauses->non_rectangular
    5589                 :       11976 :           || !gfc_nonrect_loop_expr (pblock, &se, i, orig_code->block->next,
    5590                 :             :                                      code->ext.iterator->start, &inits, simple,
    5591                 :        1428 :                                      code->ext.iterator->var))
    5592                 :             :         {
    5593                 :       10232 :           gfc_conv_expr_val (&se, code->ext.iterator->start);
    5594                 :       10232 :           gfc_add_block_to_block (pblock, &se.pre);
    5595                 :       10232 :           if (!DECL_P (se.expr))
    5596                 :        9814 :             se.expr = gfc_evaluate_now (se.expr, pblock);
    5597                 :             :         }
    5598                 :       10548 :       from = se.expr;
    5599                 :             : 
    5600                 :       10548 :       gfc_init_se (&se, NULL);
    5601                 :       10548 :       if (!clauses->non_rectangular
    5602                 :       11976 :           || !gfc_nonrect_loop_expr (pblock, &se, i, orig_code->block->next,
    5603                 :             :                                      code->ext.iterator->end, &inits, simple,
    5604                 :        1428 :                                      code->ext.iterator->var))
    5605                 :             :         {
    5606                 :       10320 :           gfc_conv_expr_val (&se, code->ext.iterator->end);
    5607                 :       10320 :           gfc_add_block_to_block (pblock, &se.pre);
    5608                 :       10320 :           if (!DECL_P (se.expr))
    5609                 :        9117 :             se.expr = gfc_evaluate_now (se.expr, pblock);
    5610                 :             :         }
    5611                 :       10548 :       to = se.expr;
    5612                 :             : 
    5613                 :       10548 :       if (!DECL_P (dovar))
    5614                 :          38 :         dovar_decl
    5615                 :          38 :           = gfc_trans_omp_variable (code->ext.iterator->var->symtree->n.sym,
    5616                 :             :                                     false);
    5617                 :       10548 :       if (simple && !DECL_P (dovar))
    5618                 :             :         {
    5619                 :          38 :           const char *name = code->ext.iterator->var->symtree->n.sym->name;
    5620                 :          38 :           local_dovar = gfc_create_var (type, name);
    5621                 :          38 :           dovar_init e = {code->ext.iterator->var->symtree->n.sym,
    5622                 :          38 :                           dovar, local_dovar, false};
    5623                 :          38 :           inits.safe_push (e);
    5624                 :             :         }
    5625                 :             :       /* Loop body.  */
    5626                 :       10548 :       if (simple)
    5627                 :             :         {
    5628                 :        9997 :           TREE_VEC_ELT (init, i) = build2_v (MODIFY_EXPR, local_dovar, from);
    5629                 :             :           /* The condition should not be folded.  */
    5630                 :       10513 :           TREE_VEC_ELT (cond, i) = build2_loc (input_location, simple > 0
    5631                 :             :                                                ? LE_EXPR : GE_EXPR,
    5632                 :             :                                                logical_type_node, local_dovar,
    5633                 :             :                                                to);
    5634                 :        9997 :           TREE_VEC_ELT (incr, i) = fold_build2_loc (input_location, PLUS_EXPR,
    5635                 :             :                                                     type, local_dovar, step);
    5636                 :        9997 :           TREE_VEC_ELT (incr, i) = fold_build2_loc (input_location,
    5637                 :             :                                                     MODIFY_EXPR,
    5638                 :             :                                                     type, local_dovar,
    5639                 :        9997 :                                                     TREE_VEC_ELT (incr, i));
    5640                 :        9997 :           if (orig_decls && !clauses->orderedc)
    5641                 :             :             orig_decls = NULL;
    5642                 :         380 :           else if (orig_decls)
    5643                 :         380 :             TREE_VEC_ELT (orig_decls, i) = dovar_decl;
    5644                 :             :         }
    5645                 :             :       else
    5646                 :             :         {
    5647                 :             :           /* STEP is not 1 or -1.  Use:
    5648                 :             :              for (count = 0; count < (to + step - from) / step; count++)
    5649                 :             :                {
    5650                 :             :                  dovar = from + count * step;
    5651                 :             :                  body;
    5652                 :             :                cycle_label:;
    5653                 :             :                }  */
    5654                 :         551 :           tmp = fold_build2_loc (input_location, MINUS_EXPR, type, step, from);
    5655                 :         551 :           tmp = fold_build2_loc (input_location, PLUS_EXPR, type, to, tmp);
    5656                 :         551 :           tmp = fold_build2_loc (input_location, TRUNC_DIV_EXPR, type, tmp,
    5657                 :             :                                  step);
    5658                 :         551 :           tmp = gfc_evaluate_now (tmp, pblock);
    5659                 :         551 :           local_dovar = gfc_create_var (type, "count");
    5660                 :         551 :           TREE_VEC_ELT (init, i) = build2_v (MODIFY_EXPR, local_dovar,
    5661                 :             :                                              build_int_cst (type, 0));
    5662                 :             :           /* The condition should not be folded.  */
    5663                 :         551 :           TREE_VEC_ELT (cond, i) = build2_loc (input_location, LT_EXPR,
    5664                 :             :                                                logical_type_node,
    5665                 :             :                                                local_dovar, tmp);
    5666                 :         551 :           TREE_VEC_ELT (incr, i) = fold_build2_loc (input_location, PLUS_EXPR,
    5667                 :             :                                                     type, local_dovar,
    5668                 :         551 :                                                     build_int_cst (type, 1));
    5669                 :         551 :           TREE_VEC_ELT (incr, i) = fold_build2_loc (input_location,
    5670                 :             :                                                     MODIFY_EXPR, type,
    5671                 :             :                                                     local_dovar,
    5672                 :         551 :                                                     TREE_VEC_ELT (incr, i));
    5673                 :             : 
    5674                 :             :           /* Initialize DOVAR.  */
    5675                 :         551 :           tmp = fold_build2_loc (input_location, MULT_EXPR, type, local_dovar,
    5676                 :             :                                  step);
    5677                 :         551 :           tmp = fold_build2_loc (input_location, PLUS_EXPR, type, from, tmp);
    5678                 :         551 :           dovar_init e = {code->ext.iterator->var->symtree->n.sym,
    5679                 :         551 :                           dovar, tmp, true};
    5680                 :         551 :           inits.safe_push (e);
    5681                 :         551 :           if (clauses->orderedc)
    5682                 :             :             {
    5683                 :         192 :               if (doacross_steps == NULL)
    5684                 :          47 :                 vec_safe_grow_cleared (doacross_steps, clauses->orderedc, true);
    5685                 :         192 :               (*doacross_steps)[i] = step;
    5686                 :             :             }
    5687                 :         551 :           if (orig_decls)
    5688                 :         198 :             TREE_VEC_ELT (orig_decls, i) = dovar_decl;
    5689                 :             :         }
    5690                 :             : 
    5691                 :       10548 :       if (dovar_found == 3
    5692                 :       10548 :           && op == EXEC_OMP_SIMD
    5693                 :         143 :           && collapse == 1
    5694                 :         143 :           && local_dovar != dovar)
    5695                 :             :         {
    5696                 :         120 :           for (tmp = omp_clauses; tmp; tmp = OMP_CLAUSE_CHAIN (tmp))
    5697                 :         120 :             if (OMP_CLAUSE_CODE (tmp) == OMP_CLAUSE_LINEAR
    5698                 :         120 :                 && OMP_CLAUSE_DECL (tmp) == dovar)
    5699                 :             :               {
    5700                 :          30 :                 OMP_CLAUSE_LINEAR_NO_COPYIN (tmp) = 1;
    5701                 :          30 :                 break;
    5702                 :             :               }
    5703                 :             :         }
    5704                 :       10548 :       if (!dovar_found && op == EXEC_OMP_SIMD)
    5705                 :             :         {
    5706                 :        1341 :           if (collapse == 1)
    5707                 :             :             {
    5708                 :         772 :               tmp = build_omp_clause (input_location, OMP_CLAUSE_LINEAR);
    5709                 :         772 :               OMP_CLAUSE_LINEAR_STEP (tmp) = step;
    5710                 :         772 :               OMP_CLAUSE_LINEAR_NO_COPYIN (tmp) = 1;
    5711                 :         772 :               OMP_CLAUSE_DECL (tmp) = dovar_decl;
    5712                 :         772 :               omp_clauses = gfc_trans_add_clause (tmp, omp_clauses);
    5713                 :         772 :               if (local_dovar != dovar)
    5714                 :             :                 dovar_found = 3;
    5715                 :             :             }
    5716                 :             :         }
    5717                 :        9207 :       else if (!dovar_found && local_dovar != dovar)
    5718                 :             :         {
    5719                 :         226 :           tmp = build_omp_clause (input_location, OMP_CLAUSE_PRIVATE);
    5720                 :         226 :           OMP_CLAUSE_DECL (tmp) = dovar_decl;
    5721                 :         226 :           omp_clauses = gfc_trans_add_clause (tmp, omp_clauses);
    5722                 :             :         }
    5723                 :       10518 :       if (dovar_found > 1)
    5724                 :             :         {
    5725                 :        1544 :           tree c = NULL;
    5726                 :             : 
    5727                 :        1544 :           tmp = NULL;
    5728                 :        1544 :           if (local_dovar != dovar)
    5729                 :             :             {
    5730                 :             :               /* If dovar is lastprivate, but different counter is used,
    5731                 :             :                  dovar += step needs to be added to
    5732                 :             :                  OMP_CLAUSE_LASTPRIVATE_STMT, otherwise the copied dovar
    5733                 :             :                  will have the value on entry of the last loop, rather
    5734                 :             :                  than value after iterator increment.  */
    5735                 :         237 :               if (clauses->orderedc)
    5736                 :             :                 {
    5737                 :          60 :                   if (clauses->collapse <= 1 || i >= clauses->collapse)
    5738                 :             :                     tmp = local_dovar;
    5739                 :             :                   else
    5740                 :          36 :                     tmp = fold_build2_loc (input_location, PLUS_EXPR,
    5741                 :             :                                            type, local_dovar,
    5742                 :             :                                            build_one_cst (type));
    5743                 :          60 :                   tmp = fold_build2_loc (input_location, MULT_EXPR, type,
    5744                 :             :                                          tmp, step);
    5745                 :          60 :                   tmp = fold_build2_loc (input_location, PLUS_EXPR, type,
    5746                 :             :                                          from, tmp);
    5747                 :             :                 }
    5748                 :             :               else
    5749                 :         177 :                 tmp = fold_build2_loc (input_location, PLUS_EXPR, type,
    5750                 :             :                                        dovar, step);
    5751                 :         237 :               tmp = fold_build2_loc (input_location, MODIFY_EXPR, type,
    5752                 :             :                                      dovar, tmp);
    5753                 :         916 :               for (c = omp_clauses; c ; c = OMP_CLAUSE_CHAIN (c))
    5754                 :         607 :                 if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_LASTPRIVATE
    5755                 :         607 :                     && OMP_CLAUSE_DECL (c) == dovar_decl)
    5756                 :             :                   {
    5757                 :         105 :                     OMP_CLAUSE_LASTPRIVATE_STMT (c) = tmp;
    5758                 :         105 :                     break;
    5759                 :             :                   }
    5760                 :         502 :                 else if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_LINEAR
    5761                 :         502 :                          && OMP_CLAUSE_DECL (c) == dovar_decl)
    5762                 :             :                   {
    5763                 :          60 :                     OMP_CLAUSE_LINEAR_STMT (c) = tmp;
    5764                 :          60 :                     break;
    5765                 :             :                   }
    5766                 :             :             }
    5767                 :        1544 :           if (c == NULL && op == EXEC_OMP_DO && par_clauses != NULL)
    5768                 :             :             {
    5769                 :         880 :               for (c = par_clauses; c ; c = OMP_CLAUSE_CHAIN (c))
    5770                 :         880 :                 if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_LASTPRIVATE
    5771                 :         880 :                     && OMP_CLAUSE_DECL (c) == dovar_decl)
    5772                 :             :                   {
    5773                 :         400 :                     tree l = build_omp_clause (input_location,
    5774                 :             :                                                OMP_CLAUSE_LASTPRIVATE);
    5775                 :         400 :                     if (OMP_CLAUSE_LASTPRIVATE_CONDITIONAL (c))
    5776                 :           4 :                       OMP_CLAUSE_LASTPRIVATE_CONDITIONAL (l) = 1;
    5777                 :         400 :                     OMP_CLAUSE_DECL (l) = dovar_decl;
    5778                 :         400 :                     OMP_CLAUSE_CHAIN (l) = omp_clauses;
    5779                 :         400 :                     OMP_CLAUSE_LASTPRIVATE_STMT (l) = tmp;
    5780                 :         400 :                     omp_clauses = l;
    5781                 :         400 :                     OMP_CLAUSE_SET_CODE (c, OMP_CLAUSE_SHARED);
    5782                 :         400 :                     break;
    5783                 :             :                   }
    5784                 :             :             }
    5785                 :        1544 :           gcc_assert (local_dovar == dovar || c != NULL);
    5786                 :             :         }
    5787                 :       10548 :       if (local_dovar != dovar)
    5788                 :             :         {
    5789                 :         589 :           if (op != EXEC_OMP_SIMD || dovar_found == 1)
    5790                 :         510 :             tmp = build_omp_clause (input_location, OMP_CLAUSE_PRIVATE);
    5791                 :          79 :           else if (collapse == 1)
    5792                 :             :             {
    5793                 :          60 :               tmp = build_omp_clause (input_location, OMP_CLAUSE_LINEAR);
    5794                 :          60 :               OMP_CLAUSE_LINEAR_STEP (tmp) = build_int_cst (type, 1);
    5795                 :          60 :               OMP_CLAUSE_LINEAR_NO_COPYIN (tmp) = 1;
    5796                 :          60 :               OMP_CLAUSE_LINEAR_NO_COPYOUT (tmp) = 1;
    5797                 :             :             }
    5798                 :             :           else
    5799                 :          19 :             tmp = build_omp_clause (input_location, OMP_CLAUSE_LASTPRIVATE);
    5800                 :         589 :           OMP_CLAUSE_DECL (tmp) = local_dovar;
    5801                 :         589 :           omp_clauses = gfc_trans_add_clause (tmp, omp_clauses);
    5802                 :             :         }
    5803                 :             : 
    5804                 :       10548 :       if (i + 1 < collapse)
    5805                 :        2321 :         code = code->block->next;
    5806                 :             :     }
    5807                 :             : 
    5808                 :        8227 :   if (pblock != &block)
    5809                 :             :     {
    5810                 :        3013 :       pushlevel ();
    5811                 :        3013 :       gfc_start_block (&block);
    5812                 :             :     }
    5813                 :             : 
    5814                 :        8227 :   gfc_start_block (&body);
    5815                 :             : 
    5816                 :       17043 :   FOR_EACH_VEC_ELT (inits, ix, di)
    5817                 :         589 :     gfc_add_modify (&body, di->var, di->init);
    5818                 :        8227 :   inits.release ();
    5819                 :             : 
    5820                 :             :   /* Cycle statement is implemented with a goto.  Exit statement must not be
    5821                 :             :      present for this loop.  */
    5822                 :        8227 :   cycle_label = gfc_build_label_decl (NULL_TREE);
    5823                 :             : 
    5824                 :             :   /* Put these labels where they can be found later.  */
    5825                 :             : 
    5826                 :        8227 :   code->cycle_label = cycle_label;
    5827                 :        8227 :   code->exit_label = NULL_TREE;
    5828                 :             : 
    5829                 :             :   /* Main loop body.  */
    5830                 :        8227 :   if (clauses->lists[OMP_LIST_REDUCTION_INSCAN])
    5831                 :             :     {
    5832                 :          16 :       gfc_code *code1, *scan, *code2, *tmpcode;
    5833                 :          16 :       code1 = tmpcode = code->block->next;
    5834                 :          16 :       if (tmpcode && tmpcode->op != EXEC_OMP_SCAN)
    5835                 :          18 :         while (tmpcode && tmpcode->next && tmpcode->next->op != EXEC_OMP_SCAN)
    5836                 :             :           tmpcode = tmpcode->next;
    5837                 :          16 :       scan = tmpcode->op == EXEC_OMP_SCAN ? tmpcode : tmpcode->next;
    5838                 :          16 :       if (code1 != scan)
    5839                 :          16 :         tmpcode->next = NULL;
    5840                 :          16 :       code2 = scan->next;
    5841                 :          16 :       gcc_assert (scan->op == EXEC_OMP_SCAN);
    5842                 :          16 :       location_t loc = gfc_get_location (&scan->loc);
    5843                 :             : 
    5844                 :          16 :       tmp = code1 != scan ? gfc_trans_code (code1) : build_empty_stmt (loc);
    5845                 :          16 :       tmp = build2 (OMP_SCAN, void_type_node, tmp, NULL_TREE);
    5846                 :          16 :       SET_EXPR_LOCATION (tmp, loc);
    5847                 :          16 :       gfc_add_expr_to_block (&body, tmp);
    5848                 :          16 :       input_location = loc;
    5849                 :          16 :       tree c = gfc_trans_omp_clauses (&body, scan->ext.omp_clauses, scan->loc);
    5850                 :          16 :       tmp = code2 ? gfc_trans_code (code2) : build_empty_stmt (loc);
    5851                 :          16 :       tmp = build2 (OMP_SCAN, void_type_node, tmp, c);
    5852                 :          16 :       SET_EXPR_LOCATION (tmp, loc);
    5853                 :          16 :       if (code1 != scan)
    5854                 :          16 :         tmpcode->next = scan;
    5855                 :             :     }
    5856                 :             :   else
    5857                 :        8211 :     tmp = gfc_trans_omp_code (code->block->next, true);
    5858                 :        8227 :   gfc_add_expr_to_block (&body, tmp);
    5859                 :             : 
    5860                 :             :   /* Label for cycle statements (if needed).  */
    5861                 :        8227 :   if (TREE_USED (cycle_label))
    5862                 :             :     {
    5863                 :        8227 :       tmp = build1_v (LABEL_EXPR, cycle_label);
    5864                 :        8227 :       gfc_add_expr_to_block (&body, tmp);
    5865                 :             :     }
    5866                 :             : 
    5867                 :             :   /* End of loop body.  */
    5868                 :        8227 :   switch (op)
    5869                 :             :     {
    5870                 :        1437 :     case EXEC_OMP_SIMD: stmt = make_node (OMP_SIMD); break;
    5871                 :        2045 :     case EXEC_OMP_DO: stmt = make_node (OMP_FOR); break;
    5872                 :          80 :     case EXEC_OMP_DISTRIBUTE: stmt = make_node (OMP_DISTRIBUTE); break;
    5873                 :          93 :     case EXEC_OMP_LOOP: stmt = make_node (OMP_LOOP); break;
    5874                 :         112 :     case EXEC_OMP_TASKLOOP: stmt = make_node (OMP_TASKLOOP); break;
    5875                 :        4460 :     case EXEC_OACC_LOOP: stmt = make_node (OACC_LOOP); break;
    5876                 :           0 :     default: gcc_unreachable ();
    5877                 :             :     }
    5878                 :             : 
    5879                 :        8227 :   SET_EXPR_LOCATION (stmt, gfc_get_location (&orig_code->loc));
    5880                 :        8227 :   TREE_TYPE (stmt) = void_type_node;
    5881                 :        8227 :   OMP_FOR_BODY (stmt) = gfc_finish_block (&body);
    5882                 :        8227 :   OMP_FOR_CLAUSES (stmt) = omp_clauses;
    5883                 :        8227 :   OMP_FOR_INIT (stmt) = init;
    5884                 :        8227 :   OMP_FOR_COND (stmt) = cond;
    5885                 :        8227 :   OMP_FOR_INCR (stmt) = incr;
    5886                 :        8227 :   if (orig_decls)
    5887                 :         137 :     OMP_FOR_ORIG_DECLS (stmt) = orig_decls;
    5888                 :        8227 :   OMP_FOR_NON_RECTANGULAR (stmt) = clauses->non_rectangular;
    5889                 :        8227 :   gfc_add_expr_to_block (&block, stmt);
    5890                 :             : 
    5891                 :        8227 :   vec_free (doacross_steps);
    5892                 :        8227 :   doacross_steps = saved_doacross_steps;
    5893                 :             : 
    5894                 :        8227 :   return gfc_finish_block (&block);
    5895                 :             : }
    5896                 :             : 
    5897                 :             : /* Translate combined OpenACC 'parallel loop', 'kernels loop', 'serial loop'
    5898                 :             :    construct. */
    5899                 :             : 
    5900                 :             : static tree
    5901                 :        1374 : gfc_trans_oacc_combined_directive (gfc_code *code)
    5902                 :             : {
    5903                 :        1374 :   stmtblock_t block, *pblock = NULL;
    5904                 :        1374 :   gfc_omp_clauses construct_clauses, loop_clauses;
    5905                 :        1374 :   tree stmt, oacc_clauses = NULL_TREE;
    5906                 :        1374 :   enum tree_code construct_code;
    5907                 :        1374 :   location_t loc = input_location;
    5908                 :             : 
    5909                 :        1374 :   switch (code->op)
    5910                 :             :     {
    5911                 :             :       case EXEC_OACC_PARALLEL_LOOP:
    5912                 :             :         construct_code = OACC_PARALLEL;
    5913                 :             :         break;
    5914                 :             :       case EXEC_OACC_KERNELS_LOOP:
    5915                 :             :         construct_code = OACC_KERNELS;
    5916                 :             :         break;
    5917                 :             :       case EXEC_OACC_SERIAL_LOOP:
    5918                 :             :         construct_code = OACC_SERIAL;
    5919                 :             :         break;
    5920                 :           0 :       default:
    5921                 :           0 :         gcc_unreachable ();
    5922                 :             :     }
    5923                 :             : 
    5924                 :        1374 :   gfc_start_block (&block);
    5925                 :             : 
    5926                 :        1374 :   memset (&loop_clauses, 0, sizeof (loop_clauses));
    5927                 :        1374 :   if (code->ext.omp_clauses != NULL)
    5928                 :             :     {
    5929                 :        1374 :       memcpy (&construct_clauses, code->ext.omp_clauses,
    5930                 :             :               sizeof (construct_clauses));
    5931                 :        1374 :       loop_clauses.collapse = construct_clauses.collapse;
    5932                 :        1374 :       loop_clauses.gang = construct_clauses.gang;
    5933                 :        1374 :       loop_clauses.gang_static = construct_clauses.gang_static;
    5934                 :        1374 :       loop_clauses.gang_num_expr = construct_clauses.gang_num_expr;
    5935                 :        1374 :       loop_clauses.gang_static_expr = construct_clauses.gang_static_expr;
    5936                 :        1374 :       loop_clauses.vector = construct_clauses.vector;
    5937                 :        1374 :       loop_clauses.vector_expr = construct_clauses.vector_expr;
    5938                 :        1374 :       loop_clauses.worker = construct_clauses.worker;
    5939                 :        1374 :       loop_clauses.worker_expr = construct_clauses.worker_expr;
    5940                 :        1374 :       loop_clauses.seq = construct_clauses.seq;
    5941                 :        1374 :       loop_clauses.par_auto = construct_clauses.par_auto;
    5942                 :        1374 :       loop_clauses.independent = construct_clauses.independent;
    5943                 :        1374 :       loop_clauses.tile_list = construct_clauses.tile_list;
    5944                 :        1374 :       loop_clauses.lists[OMP_LIST_PRIVATE]
    5945                 :        1374 :         = construct_clauses.lists[OMP_LIST_PRIVATE];
    5946                 :        1374 :       loop_clauses.lists[OMP_LIST_REDUCTION]
    5947                 :        1374 :         = construct_clauses.lists[OMP_LIST_REDUCTION];
    5948                 :        1374 :       construct_clauses.gang = false;
    5949                 :        1374 :       construct_clauses.gang_static = false;
    5950                 :        1374 :       construct_clauses.gang_num_expr = NULL;
    5951                 :        1374 :       construct_clauses.gang_static_expr = NULL;
    5952                 :        1374 :       construct_clauses.vector = false;
    5953                 :        1374 :       construct_clauses.vector_expr = NULL;
    5954                 :        1374 :       construct_clauses.worker = false;
    5955                 :        1374 :       construct_clauses.worker_expr = NULL;
    5956                 :        1374 :       construct_clauses.seq = false;
    5957                 :        1374 :       construct_clauses.par_auto = false;
    5958                 :        1374 :       construct_clauses.independent = false;
    5959                 :        1374 :       construct_clauses.independent = false;
    5960                 :        1374 :       construct_clauses.tile_list = NULL;
    5961                 :        1374 :       construct_clauses.lists[OMP_LIST_PRIVATE] = NULL;
    5962                 :        1374 :       if (construct_code == OACC_KERNELS)
    5963                 :          86 :         construct_clauses.lists[OMP_LIST_REDUCTION] = NULL;
    5964                 :        1374 :       oacc_clauses = gfc_trans_omp_clauses (&block, &construct_clauses,
    5965                 :             :                                             code->loc, false, true);
    5966                 :             :     }
    5967                 :        1374 :   if (!loop_clauses.seq)
    5968                 :             :     pblock = &block;
    5969                 :             :   else
    5970                 :          31 :     pushlevel ();
    5971                 :        1374 :   stmt = gfc_trans_omp_do (code, EXEC_OACC_LOOP, pblock, &loop_clauses, NULL);
    5972                 :        1374 :   protected_set_expr_location (stmt, loc);
    5973                 :        1374 :   if (TREE_CODE (stmt) != BIND_EXPR)
    5974                 :        1374 :     stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0));
    5975                 :             :   else
    5976                 :           0 :     poplevel (0, 0);
    5977                 :        1374 :   stmt = build2_loc (loc, construct_code, void_type_node, stmt, oacc_clauses);
    5978                 :        1374 :   gfc_add_expr_to_block (&block, stmt);
    5979                 :        1374 :   return gfc_finish_block (&block);
    5980                 :             : }
    5981                 :             : 
    5982                 :             : static tree
    5983                 :         102 : gfc_trans_omp_depobj (gfc_code *code)
    5984                 :             : {
    5985                 :         102 :   stmtblock_t block;
    5986                 :         102 :   gfc_se se;
    5987                 :         102 :   gfc_init_se (&se, NULL);
    5988                 :         102 :   gfc_init_block (&block);
    5989                 :         102 :   gfc_conv_expr (&se, code->ext.omp_clauses->depobj);
    5990                 :         102 :   gcc_assert (se.pre.head == NULL && se.post.head == NULL);
    5991                 :         102 :   tree depobj = se.expr;
    5992                 :         102 :   location_t loc = EXPR_LOCATION (depobj);
    5993                 :         102 :   if (!POINTER_TYPE_P (TREE_TYPE (depobj)))
    5994                 :         102 :     depobj = gfc_build_addr_expr (NULL, depobj);
    5995                 :         102 :   depobj = fold_convert (build_pointer_type_for_mode (ptr_type_node,
    5996                 :             :                                                       TYPE_MODE (ptr_type_node),
    5997                 :             :                                                       true), depobj);
    5998                 :         102 :   gfc_omp_namelist *n = code->ext.omp_clauses->lists[OMP_LIST_DEPEND];
    5999                 :         102 :   if (n)
    6000                 :             :     {
    6001                 :          82 :       tree var;
    6002                 :          82 :       if (!n->sym)  /* omp_all_memory.  */
    6003                 :           3 :         var = null_pointer_node;
    6004                 :          79 :       else if (n->expr && n->expr->ref->u.ar.type != AR_FULL)
    6005                 :             :         {
    6006                 :          18 :           gfc_init_se (&se, NULL);
    6007                 :          18 :           if (n->expr->ref->u.ar.type == AR_ELEMENT)
    6008                 :             :             {
    6009                 :          18 :               gfc_conv_expr_reference (&se, n->expr);
    6010                 :          18 :               var = se.expr;
    6011                 :             :             }
    6012                 :             :           else
    6013                 :             :             {
    6014                 :           0 :               gfc_conv_expr_descriptor (&se, n->expr);
    6015                 :           0 :               var = gfc_conv_array_data (se.expr);
    6016                 :             :             }
    6017                 :          18 :           gfc_add_block_to_block (&block, &se.pre);
    6018                 :          18 :           gfc_add_block_to_block (&block, &se.post);
    6019                 :          18 :           gcc_assert (POINTER_TYPE_P (TREE_TYPE (var)));
    6020                 :             :         }
    6021                 :             :       else
    6022                 :             :         {
    6023                 :          61 :           var = gfc_get_symbol_decl (n->sym);
    6024                 :          98 :           if (POINTER_TYPE_P (TREE_TYPE (var))
    6025                 :          71 :               && GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (TREE_TYPE (var))))
    6026                 :           8 :             var = build_fold_indirect_ref (var);
    6027                 :          61 :           if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (var)))
    6028                 :             :             {
    6029                 :          12 :               var = gfc_conv_descriptor_data_get (var);
    6030                 :          12 :               gcc_assert (POINTER_TYPE_P (TREE_TYPE (var)));
    6031                 :             :             }
    6032                 :          49 :           else if ((n->sym->attr.allocatable || n->sym->attr.pointer)
    6033                 :          13 :                    && n->sym->attr.dummy)
    6034                 :           8 :             var = build_fold_indirect_ref (var);
    6035                 :          66 :           else if (!POINTER_TYPE_P (TREE_TYPE (var))
    6036                 :          43 :                    || (n->sym->ts.f90_type == BT_VOID
    6037                 :          11 :                        && !POINTER_TYPE_P (TREE_TYPE (TREE_TYPE (var)))
    6038                 :           7 :                        && !GFC_ARRAY_TYPE_P (TREE_TYPE (TREE_TYPE (var)))))
    6039                 :             :             {
    6040                 :          28 :               TREE_ADDRESSABLE (var) = 1;
    6041                 :          28 :               var = gfc_build_addr_expr (NULL, var);
    6042                 :             :             }
    6043                 :             :         }
    6044                 :          82 :       depobj = save_expr (depobj);
    6045                 :          82 :       tree r = build_fold_indirect_ref_loc (loc, depobj);
    6046                 :          82 :       gfc_add_expr_to_block (&block,
    6047                 :             :                              build2 (MODIFY_EXPR, void_type_node, r, var));
    6048                 :             :     }
    6049                 :             : 
    6050                 :             :   /* Only one may be set. */
    6051                 :         102 :   gcc_assert (((int)(n != NULL) + (int)(code->ext.omp_clauses->destroy)
    6052                 :             :               + (int)(code->ext.omp_clauses->depobj_update != OMP_DEPEND_UNSET))
    6053                 :             :               == 1);
    6054                 :         102 :   int k = -1; /* omp_clauses->destroy */
    6055                 :         102 :   if (!code->ext.omp_clauses->destroy)
    6056                 :          91 :     switch (code->ext.omp_clauses->depobj_update != OMP_DEPEND_UNSET
    6057                 :          91 :             ? code->ext.omp_clauses->depobj_update : n->u.depend_doacross_op)
    6058                 :             :       {
    6059                 :             :       case OMP_DEPEND_IN: k = GOMP_DEPEND_IN; break;
    6060                 :             :       case OMP_DEPEND_OUT: k = GOMP_DEPEND_OUT; break;
    6061                 :             :       case OMP_DEPEND_INOUT: k = GOMP_DEPEND_INOUT; break;
    6062                 :             :       case OMP_DEPEND_INOUTSET: k = GOMP_DEPEND_INOUTSET; break;
    6063                 :             :       case OMP_DEPEND_MUTEXINOUTSET: k = GOMP_DEPEND_MUTEXINOUTSET; break;
    6064                 :           0 :       default: gcc_unreachable ();
    6065                 :             :       }
    6066                 :         102 :   tree t = build_int_cst (ptr_type_node, k);
    6067                 :         102 :   depobj = build2_loc (loc, POINTER_PLUS_EXPR, TREE_TYPE (depobj), depobj,
    6068                 :         102 :                        TYPE_SIZE_UNIT (ptr_type_node));
    6069                 :         102 :   depobj = build_fold_indirect_ref_loc (loc, depobj);
    6070                 :         102 :   gfc_add_expr_to_block (&block, build2 (MODIFY_EXPR, void_type_node, depobj, t));
    6071                 :             : 
    6072                 :         102 :   return gfc_finish_block (&block);
    6073                 :             : }
    6074                 :             : 
    6075                 :             : static tree
    6076                 :          18 : gfc_trans_omp_error (gfc_code *code)
    6077                 :             : {
    6078                 :          18 :   stmtblock_t block;
    6079                 :          18 :   gfc_se se;
    6080                 :          18 :   tree len, message;
    6081                 :          18 :   bool fatal = code->ext.omp_clauses->severity == OMP_SEVERITY_FATAL;
    6082                 :          31 :   tree fndecl = builtin_decl_explicit (fatal ? BUILT_IN_GOMP_ERROR
    6083                 :             :                                              : BUILT_IN_GOMP_WARNING);
    6084                 :          18 :   gfc_start_block (&block);
    6085                 :          18 :   gfc_init_se (&se, NULL );
    6086                 :          18 :   if (!code->ext.omp_clauses->message)
    6087                 :             :     {
    6088                 :           3 :       message = null_pointer_node;
    6089                 :           3 :       len = build_int_cst (size_type_node, 0);
    6090                 :             :     }
    6091                 :             :   else
    6092                 :             :     {
    6093                 :          15 :       gfc_conv_expr (&se, code->ext.omp_clauses->message);
    6094                 :          15 :       message = se.expr;
    6095                 :          15 :       if (!POINTER_TYPE_P (TREE_TYPE (message)))
    6096                 :             :         /* To ensure an ARRAY_TYPE is not passed as such.  */
    6097                 :           6 :         message = gfc_build_addr_expr (NULL, message);
    6098                 :          15 :       len = se.string_length;
    6099                 :             :     }
    6100                 :          18 :   gfc_add_block_to_block (&block, &se.pre);
    6101                 :          18 :   gfc_add_expr_to_block (&block, build_call_expr_loc (input_location, fndecl,
    6102                 :             :                                                       2, message, len));
    6103                 :          18 :   gfc_add_block_to_block (&block, &se.post);
    6104                 :          18 :   return gfc_finish_block (&block);
    6105                 :             : }
    6106                 :             : 
    6107                 :             : static tree
    6108                 :          68 : gfc_trans_omp_flush (gfc_code *code)
    6109                 :             : {
    6110                 :          68 :   tree call;
    6111                 :          68 :   if (!code->ext.omp_clauses
    6112                 :           4 :       || code->ext.omp_clauses->memorder == OMP_MEMORDER_UNSET
    6113                 :           4 :       || code->ext.omp_clauses->memorder == OMP_MEMORDER_SEQ_CST)
    6114                 :             :     {
    6115                 :          65 :       call = builtin_decl_explicit (BUILT_IN_SYNC_SYNCHRONIZE);
    6116                 :          65 :       call = build_call_expr_loc (input_location, call, 0);
    6117                 :             :     }
    6118                 :             :   else
    6119                 :             :     {
    6120                 :           3 :       enum memmodel mo = MEMMODEL_LAST;
    6121                 :           3 :       switch (code->ext.omp_clauses->memorder)
    6122                 :             :         {
    6123                 :             :         case OMP_MEMORDER_ACQ_REL: mo = MEMMODEL_ACQ_REL; break;
    6124                 :             :         case OMP_MEMORDER_RELEASE: mo = MEMMODEL_RELEASE; break;
    6125                 :             :         case OMP_MEMORDER_ACQUIRE: mo = MEMMODEL_ACQUIRE; break;
    6126                 :           0 :         default: gcc_unreachable (); break;
    6127                 :             :         }
    6128                 :           3 :       call = builtin_decl_explicit (BUILT_IN_ATOMIC_THREAD_FENCE);
    6129                 :           3 :       call = build_call_expr_loc (input_location, call, 1,
    6130                 :             :                                   build_int_cst (integer_type_node, mo));
    6131                 :             :     }
    6132                 :          68 :   return call;
    6133                 :             : }
    6134                 :             : 
    6135                 :             : static tree
    6136                 :         115 : gfc_trans_omp_master (gfc_code *code)
    6137                 :             : {
    6138                 :         115 :   tree stmt = gfc_trans_code (code->block->next);
    6139                 :         115 :   if (IS_EMPTY_STMT (stmt))
    6140                 :             :     return stmt;
    6141                 :         109 :   return build1_v (OMP_MASTER, stmt);
    6142                 :             : }
    6143                 :             : 
    6144                 :             : static tree
    6145                 :          48 : gfc_trans_omp_masked (gfc_code *code, gfc_omp_clauses *clauses)
    6146                 :             : {
    6147                 :          48 :   stmtblock_t block;
    6148                 :          48 :   tree body = gfc_trans_code (code->block->next);
    6149                 :          48 :   if (IS_EMPTY_STMT (body))
    6150                 :             :     return body;
    6151                 :          39 :   if (!clauses)
    6152                 :          32 :     clauses = code->ext.omp_clauses;
    6153                 :          39 :   gfc_start_block (&block);
    6154                 :          39 :   tree omp_clauses = gfc_trans_omp_clauses (&block, clauses, code->loc);
    6155                 :          39 :   tree stmt = make_node (OMP_MASKED);
    6156                 :          39 :   SET_EXPR_LOCATION (stmt, gfc_get_location (&code->loc));
    6157                 :          39 :   TREE_TYPE (stmt) = void_type_node;
    6158                 :          39 :   OMP_MASKED_BODY (stmt) = body;
    6159                 :          39 :   OMP_MASKED_CLAUSES (stmt) = omp_clauses;
    6160                 :          39 :   gfc_add_expr_to_block (&block, stmt);
    6161                 :          39 :   return gfc_finish_block (&block);
    6162                 :             : }
    6163                 :             : 
    6164                 :             : 
    6165                 :             : static tree
    6166                 :         519 : gfc_trans_omp_ordered (gfc_code *code)
    6167                 :             : {
    6168                 :         519 :   if (!flag_openmp)
    6169                 :             :     {
    6170                 :           5 :       if (!code->ext.omp_clauses->simd)
    6171                 :           3 :         return gfc_trans_code (code->block ? code->block->next : NULL);
    6172                 :           2 :       code->ext.omp_clauses->threads = 0;
    6173                 :             :     }
    6174                 :         516 :   tree omp_clauses = gfc_trans_omp_clauses (NULL, code->ext.omp_clauses,
    6175                 :             :                                             code->loc);
    6176                 :         516 :   return build2_loc (input_location, OMP_ORDERED, void_type_node,
    6177                 :         516 :                      code->block ? gfc_trans_code (code->block->next)
    6178                 :         516 :                      : NULL_TREE, omp_clauses);
    6179                 :             : }
    6180                 :             : 
    6181                 :             : static tree
    6182                 :        1820 : gfc_trans_omp_parallel (gfc_code *code)
    6183                 :             : {
    6184                 :        1820 :   stmtblock_t block;
    6185                 :        1820 :   tree stmt, omp_clauses;
    6186                 :             : 
    6187                 :        1820 :   gfc_start_block (&block);
    6188                 :        1820 :   omp_clauses = gfc_trans_omp_clauses (&block, code->ext.omp_clauses,
    6189                 :             :                                        code->loc);
    6190                 :        1820 :   pushlevel ();
    6191                 :        1820 :   stmt = gfc_trans_omp_code (code->block->next, true);
    6192                 :        1820 :   stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0));
    6193                 :        1820 :   stmt = build2_loc (input_location, OMP_PARALLEL, void_type_node, stmt,
    6194                 :             :                      omp_clauses);
    6195                 :        1820 :   gfc_add_expr_to_block (&block, stmt);
    6196                 :        1820 :   return gfc_finish_block (&block);
    6197                 :             : }
    6198                 :             : 
    6199                 :             : enum
    6200                 :             : {
    6201                 :             :   GFC_OMP_SPLIT_SIMD,
    6202                 :             :   GFC_OMP_SPLIT_DO,
    6203                 :             :   GFC_OMP_SPLIT_PARALLEL,
    6204                 :             :   GFC_OMP_SPLIT_DISTRIBUTE,
    6205                 :             :   GFC_OMP_SPLIT_TEAMS,
    6206                 :             :   GFC_OMP_SPLIT_TARGET,
    6207                 :             :   GFC_OMP_SPLIT_TASKLOOP,
    6208                 :             :   GFC_OMP_SPLIT_MASKED,
    6209                 :             :   GFC_OMP_SPLIT_NUM
    6210                 :             : };
    6211                 :             : 
    6212                 :             : enum
    6213                 :             : {
    6214                 :             :   GFC_OMP_MASK_SIMD = (1 << GFC_OMP_SPLIT_SIMD),
    6215                 :             :   GFC_OMP_MASK_DO = (1 << GFC_OMP_SPLIT_DO),
    6216                 :             :   GFC_OMP_MASK_PARALLEL = (1 << GFC_OMP_SPLIT_PARALLEL),
    6217                 :             :   GFC_OMP_MASK_DISTRIBUTE = (1 << GFC_OMP_SPLIT_DISTRIBUTE),
    6218                 :             :   GFC_OMP_MASK_TEAMS = (1 << GFC_OMP_SPLIT_TEAMS),
    6219                 :             :   GFC_OMP_MASK_TARGET = (1 << GFC_OMP_SPLIT_TARGET),
    6220                 :             :   GFC_OMP_MASK_TASKLOOP = (1 << GFC_OMP_SPLIT_TASKLOOP),
    6221                 :             :   GFC_OMP_MASK_MASKED = (1 << GFC_OMP_SPLIT_MASKED)
    6222                 :             : };
    6223                 :             : 
    6224                 :             : /* If a var is in lastprivate/firstprivate/reduction but not in a
    6225                 :             :    data mapping/sharing clause, add it to 'map(tofrom:' if is_target
    6226                 :             :    and to 'shared' otherwise.  */
    6227                 :             : static void
    6228                 :        2121 : gfc_add_clause_implicitly (gfc_omp_clauses *clauses_out,
    6229                 :             :                            gfc_omp_clauses *clauses_in,
    6230                 :             :                            bool is_target, bool is_parallel_do)
    6231                 :             : {
    6232                 :        2121 :   int clauselist_to_add = is_target ? OMP_LIST_MAP : OMP_LIST_SHARED;
    6233                 :        2121 :   gfc_omp_namelist *tail = NULL;
    6234                 :       12726 :   for (int i = 0; i < 5; ++i)
    6235                 :             :     {
    6236                 :       10605 :       gfc_omp_namelist *n;
    6237                 :       10605 :       switch (i)
    6238                 :             :         {
    6239                 :        2121 :         case 0: n = clauses_in->lists[OMP_LIST_FIRSTPRIVATE]; break;
    6240                 :        2121 :         case 1: n = clauses_in->lists[OMP_LIST_LASTPRIVATE]; break;
    6241                 :        2121 :         case 2: n = clauses_in->lists[OMP_LIST_REDUCTION]; break;
    6242                 :        2121 :         case 3: n = clauses_in->lists[OMP_LIST_REDUCTION_INSCAN]; break;
    6243                 :        2121 :         case 4: n = clauses_in->lists[OMP_LIST_REDUCTION_TASK]; break;
    6244                 :             :         default: gcc_unreachable ();
    6245                 :             :         }
    6246                 :       13805 :       for (; n != NULL; n = n->next)
    6247                 :             :         {
    6248                 :             :           gfc_omp_namelist *n2, **n_firstp = NULL, **n_lastp = NULL;
    6249                 :       20014 :           for (int j = 0; j < 6; ++j)
    6250                 :             :             {
    6251                 :       17590 :               gfc_omp_namelist **n2ref = NULL, *prev2 = NULL;
    6252                 :       17590 :               switch (j)
    6253                 :             :                 {
    6254                 :        3200 :                 case 0:
    6255                 :        3200 :                   n2ref = &clauses_out->lists[clauselist_to_add];
    6256                 :        3200 :                   break;
    6257                 :        3176 :                 case 1:
    6258                 :        3176 :                   n2ref = &clauses_out->lists[OMP_LIST_FIRSTPRIVATE];
    6259                 :        3176 :                   break;
    6260                 :        3176 :                 case 2:
    6261                 :        3176 :                   if (is_target)
    6262                 :         255 :                     n2ref = &clauses_in->lists[OMP_LIST_LASTPRIVATE];
    6263                 :             :                   else
    6264                 :        2921 :                     n2ref = &clauses_out->lists[OMP_LIST_LASTPRIVATE];
    6265                 :             :                   break;
    6266                 :        3176 :                 case 3: n2ref = &clauses_out->lists[OMP_LIST_REDUCTION]; break;
    6267                 :        2431 :                 case 4:
    6268                 :        2431 :                   n2ref = &clauses_out->lists[OMP_LIST_REDUCTION_INSCAN];
    6269                 :        2431 :                   break;
    6270                 :        2431 :                 case 5:
    6271                 :        2431 :                   n2ref = &clauses_out->lists[OMP_LIST_REDUCTION_TASK];
    6272                 :        2431 :                   break;
    6273                 :             :                 default: gcc_unreachable ();
    6274                 :             :                 }
    6275                 :       27822 :               for (n2 = *n2ref; n2 != NULL; prev2 = n2, n2 = n2->next)
    6276                 :       13360 :                 if (n2->sym == n->sym)
    6277                 :             :                   break;
    6278                 :       17590 :               if (n2)
    6279                 :             :                 {
    6280                 :        3128 :                   if (j == 0 /* clauselist_to_add */)
    6281                 :             :                     break;  /* Already present.  */
    6282                 :        3104 :                   if (j == 1 /* OMP_LIST_FIRSTPRIVATE */)
    6283                 :             :                     {
    6284                 :        1128 :                       n_firstp = prev2 ? &prev2->next : n2ref;
    6285                 :        1128 :                       continue;
    6286                 :             :                     }
    6287                 :        1976 :                   if (j == 2 /* OMP_LIST_LASTPRIVATE */)
    6288                 :             :                     {
    6289                 :        1224 :                       n_lastp = prev2 ? &prev2->next : n2ref;
    6290                 :        1224 :                       continue;
    6291                 :             :                     }
    6292                 :             :                   break;
    6293                 :             :                 }
    6294                 :             :             }
    6295                 :        3200 :           if (n_firstp && n_lastp)
    6296                 :             :             {
    6297                 :             :               /* For parallel do, GCC puts firstprivate/lastprivate
    6298                 :             :                  on the parallel.  */
    6299                 :         283 :               if (is_parallel_do)
    6300                 :         280 :                 continue;
    6301                 :           3 :               *n_firstp = (*n_firstp)->next;
    6302                 :           3 :               if (!is_target)
    6303                 :           0 :                 *n_lastp = (*n_lastp)->next;
    6304                 :             :             }
    6305                 :        2917 :           else if (is_target && n_lastp)
    6306                 :             :             ;
    6307                 :        2862 :           else if (n2 || n_firstp || n_lastp)
    6308                 :        2507 :             continue;
    6309                 :         413 :           if (clauses_out->lists[clauselist_to_add]
    6310                 :         305 :               && (clauses_out->lists[clauselist_to_add]
    6311                 :         305 :                   == clauses_in->lists[clauselist_to_add]))
    6312                 :             :             {
    6313                 :             :               gfc_omp_namelist *p = NULL;
    6314                 :         421 :               for (n2 = clauses_in->lists[clauselist_to_add]; n2; n2 = n2->next)
    6315                 :             :                 {
    6316                 :         273 :                   if (p)
    6317                 :             :                     {
    6318                 :         125 :                       p->next = gfc_get_omp_namelist ();
    6319                 :         125 :                       p = p->next;
    6320                 :             :                     }
    6321                 :             :                   else
    6322                 :             :                     {
    6323                 :         148 :                       p = gfc_get_omp_namelist ();
    6324                 :         148 :                       clauses_out->lists[clauselist_to_add] = p;
    6325                 :             :                     }
    6326                 :         273 :                   *p = *n2;
    6327                 :             :                 }
    6328                 :             :             }
    6329                 :         413 :           if (!tail)
    6330                 :             :             {
    6331                 :         284 :               tail = clauses_out->lists[clauselist_to_add];
    6332                 :         409 :               for (; tail && tail->next; tail = tail->next)
    6333                 :             :                 ;
    6334                 :             :             }
    6335                 :         413 :           n2 = gfc_get_omp_namelist ();
    6336                 :         413 :           n2->where = n->where;
    6337                 :         413 :           n2->sym = n->sym;
    6338                 :         413 :           if (is_target)
    6339                 :         119 :             n2->u.map_op = OMP_MAP_TOFROM;
    6340                 :         413 :           if (tail)
    6341                 :             :             {
    6342                 :         305 :               tail->next = n2;
    6343                 :         305 :               tail = n2;
    6344                 :             :             }
    6345                 :             :           else
    6346                 :         108 :             clauses_out->lists[clauselist_to_add] = n2;
    6347                 :             :         }
    6348                 :             :     }
    6349                 :        2121 : }
    6350                 :             : 
    6351                 :             : /* Kind of opposite to above, add firstprivate to CLAUSES_OUT if it is mapped
    6352                 :             :    in CLAUSES_IN's FIRSTPRIVATE list but not its MAP list.  */
    6353                 :             : 
    6354                 :             : static void
    6355                 :         287 : gfc_add_firstprivate_if_unmapped (gfc_omp_clauses *clauses_out,
    6356                 :             :                                   gfc_omp_clauses *clauses_in)
    6357                 :             : {
    6358                 :         287 :   gfc_omp_namelist *n = clauses_in->lists[OMP_LIST_FIRSTPRIVATE];
    6359                 :         287 :   gfc_omp_namelist **tail = NULL;
    6360                 :             : 
    6361                 :         437 :   for (; n != NULL; n = n->next)
    6362                 :             :     {
    6363                 :         150 :       gfc_omp_namelist *n2 = clauses_out->lists[OMP_LIST_MAP];
    6364                 :         192 :       for (; n2 != NULL; n2 = n2->next)
    6365                 :          53 :         if (n->sym == n2->sym)
    6366                 :             :           break;
    6367                 :         150 :       if (n2 == NULL)
    6368                 :             :         {
    6369                 :         139 :           gfc_omp_namelist *dup = gfc_get_omp_namelist ();
    6370                 :         139 :           *dup = *n;
    6371                 :         139 :           dup->next = NULL;
    6372                 :         139 :           if (!tail)
    6373                 :             :             {
    6374                 :          76 :               tail = &clauses_out->lists[OMP_LIST_FIRSTPRIVATE];
    6375                 :          76 :               while (*tail && (*tail)->next)
    6376                 :           0 :                 tail = &(*tail)->next;
    6377                 :             :             }
    6378                 :         139 :           *tail = dup;
    6379                 :         139 :           tail = &(*tail)->next;
    6380                 :             :         }
    6381                 :             :     }
    6382                 :         287 : }
    6383                 :             : 
    6384                 :             : static void
    6385                 :        3319 : gfc_free_split_omp_clauses (gfc_code *code, gfc_omp_clauses *clausesa)
    6386                 :             : {
    6387                 :       29871 :   for (int i = 0; i < GFC_OMP_SPLIT_NUM; ++i)
    6388                 :      902768 :     for (int j = 0; j < OMP_LIST_NUM; ++j)
    6389                 :      876216 :       if (clausesa[i].lists[j] && clausesa[i].lists[j] != code->ext.omp_clauses->lists[j])
    6390                 :        1387 :         for (gfc_omp_namelist *n = clausesa[i].lists[j]; n;)
    6391                 :             :           {
    6392                 :         951 :             gfc_omp_namelist *p = n;
    6393                 :         951 :             n = n->next;
    6394                 :         951 :             free (p);
    6395                 :             :           }
    6396                 :        3319 : }
    6397                 :             : 
    6398                 :             : static void
    6399                 :        3319 : gfc_split_omp_clauses (gfc_code *code,
    6400                 :             :                        gfc_omp_clauses clausesa[GFC_OMP_SPLIT_NUM])
    6401                 :             : {
    6402                 :        3319 :   int mask = 0, innermost = 0;
    6403                 :        3319 :   bool is_loop = false;
    6404                 :        3319 :   memset (clausesa, 0, GFC_OMP_SPLIT_NUM * sizeof (gfc_omp_clauses));
    6405                 :        3319 :   switch (code->op)
    6406                 :             :     {
    6407                 :             :     case EXEC_OMP_DISTRIBUTE:
    6408                 :             :       innermost = GFC_OMP_SPLIT_DISTRIBUTE;
    6409                 :             :       break;
    6410                 :          30 :     case EXEC_OMP_DISTRIBUTE_PARALLEL_DO:
    6411                 :          30 :       mask = GFC_OMP_MASK_DISTRIBUTE | GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_DO;
    6412                 :          30 :       innermost = GFC_OMP_SPLIT_DO;
    6413                 :          30 :       break;
    6414                 :          28 :     case EXEC_OMP_DISTRIBUTE_PARALLEL_DO_SIMD:
    6415                 :          28 :       mask = GFC_OMP_MASK_DISTRIBUTE | GFC_OMP_MASK_PARALLEL
    6416                 :             :              | GFC_OMP_MASK_DO | GFC_OMP_MASK_SIMD;
    6417                 :          28 :       innermost = GFC_OMP_SPLIT_SIMD;
    6418                 :          28 :       break;
    6419                 :          47 :     case EXEC_OMP_DISTRIBUTE_SIMD:
    6420                 :          47 :       mask = GFC_OMP_MASK_DISTRIBUTE | GFC_OMP_MASK_SIMD;
    6421                 :          47 :       innermost = GFC_OMP_SPLIT_SIMD;
    6422                 :          47 :       break;
    6423                 :           0 :     case EXEC_OMP_DO:
    6424                 :           0 :     case EXEC_OMP_LOOP:
    6425                 :           0 :       innermost = GFC_OMP_SPLIT_DO;
    6426                 :           0 :       break;
    6427                 :         126 :     case EXEC_OMP_DO_SIMD:
    6428                 :         126 :       mask = GFC_OMP_MASK_DO | GFC_OMP_MASK_SIMD;
    6429                 :         126 :       innermost = GFC_OMP_SPLIT_SIMD;
    6430                 :         126 :       break;
    6431                 :           0 :     case EXEC_OMP_PARALLEL:
    6432                 :           0 :       innermost = GFC_OMP_SPLIT_PARALLEL;
    6433                 :           0 :       break;
    6434                 :         837 :     case EXEC_OMP_PARALLEL_DO:
    6435                 :         837 :     case EXEC_OMP_PARALLEL_LOOP:
    6436                 :         837 :       mask = GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_DO;
    6437                 :         837 :       innermost = GFC_OMP_SPLIT_DO;
    6438                 :         837 :       break;
    6439                 :         278 :     case EXEC_OMP_PARALLEL_DO_SIMD:
    6440                 :         278 :       mask = GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_DO | GFC_OMP_MASK_SIMD;
    6441                 :         278 :       innermost = GFC_OMP_SPLIT_SIMD;
    6442                 :         278 :       break;
    6443                 :          11 :     case EXEC_OMP_PARALLEL_MASKED:
    6444                 :          11 :       mask = GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_MASKED;
    6445                 :          11 :       innermost = GFC_OMP_SPLIT_MASKED;
    6446                 :          11 :       break;
    6447                 :          14 :     case EXEC_OMP_PARALLEL_MASKED_TASKLOOP:
    6448                 :          14 :       mask = (GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_MASKED
    6449                 :             :               | GFC_OMP_MASK_TASKLOOP | GFC_OMP_MASK_SIMD);
    6450                 :          14 :       innermost = GFC_OMP_SPLIT_TASKLOOP;
    6451                 :          14 :       break;
    6452                 :          20 :     case EXEC_OMP_PARALLEL_MASTER_TASKLOOP:
    6453                 :          20 :       mask = GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_TASKLOOP | GFC_OMP_MASK_SIMD;
    6454                 :          20 :       innermost = GFC_OMP_SPLIT_TASKLOOP;
    6455                 :          20 :       break;
    6456                 :          24 :     case EXEC_OMP_PARALLEL_MASKED_TASKLOOP_SIMD:
    6457                 :          24 :       mask = (GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_MASKED
    6458                 :             :               | GFC_OMP_MASK_TASKLOOP | GFC_OMP_MASK_SIMD);
    6459                 :          24 :       innermost = GFC_OMP_SPLIT_SIMD;
    6460                 :          24 :       break;
    6461                 :          26 :     case EXEC_OMP_PARALLEL_MASTER_TASKLOOP_SIMD:
    6462                 :          26 :       mask = GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_TASKLOOP | GFC_OMP_MASK_SIMD;
    6463                 :          26 :       innermost = GFC_OMP_SPLIT_SIMD;
    6464                 :          26 :       break;
    6465                 :           0 :     case EXEC_OMP_SIMD:
    6466                 :           0 :       innermost = GFC_OMP_SPLIT_SIMD;
    6467                 :           0 :       break;
    6468                 :        1250 :     case EXEC_OMP_TARGET:
    6469                 :        1250 :       innermost = GFC_OMP_SPLIT_TARGET;
    6470                 :        1250 :       break;
    6471                 :          20 :     case EXEC_OMP_TARGET_PARALLEL:
    6472                 :          20 :       mask = GFC_OMP_MASK_TARGET | GFC_OMP_MASK_PARALLEL;
    6473                 :          20 :       innermost = GFC_OMP_SPLIT_PARALLEL;
    6474                 :          20 :       break;
    6475                 :          51 :     case EXEC_OMP_TARGET_PARALLEL_DO:
    6476                 :          51 :     case EXEC_OMP_TARGET_PARALLEL_LOOP:
    6477                 :          51 :       mask = GFC_OMP_MASK_TARGET | GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_DO;
    6478                 :          51 :       innermost = GFC_OMP_SPLIT_DO;
    6479                 :          51 :       break;
    6480                 :          15 :     case EXEC_OMP_TARGET_PARALLEL_DO_SIMD:
    6481                 :          15 :       mask = GFC_OMP_MASK_TARGET | GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_DO
    6482                 :             :              | GFC_OMP_MASK_SIMD;
    6483                 :          15 :       innermost = GFC_OMP_SPLIT_SIMD;
    6484                 :          15 :       break;
    6485                 :          26 :     case EXEC_OMP_TARGET_SIMD:
    6486                 :          26 :       mask = GFC_OMP_MASK_TARGET | GFC_OMP_MASK_SIMD;
    6487                 :          26 :       innermost = GFC_OMP_SPLIT_SIMD;
    6488                 :          26 :       break;
    6489                 :          63 :     case EXEC_OMP_TARGET_TEAMS:
    6490                 :          63 :       mask = GFC_OMP_MASK_TARGET | GFC_OMP_MASK_TEAMS;
    6491                 :          63 :       innermost = GFC_OMP_SPLIT_TEAMS;
    6492                 :          63 :       break;
    6493                 :          14 :     case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE:
    6494                 :          14 :       mask = GFC_OMP_MASK_TARGET | GFC_OMP_MASK_TEAMS
    6495                 :             :              | GFC_OMP_MASK_DISTRIBUTE;
    6496                 :          14 :       innermost = GFC_OMP_SPLIT_DISTRIBUTE;
    6497                 :          14 :       break;
    6498                 :          43 :     case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO:
    6499                 :          43 :       mask = GFC_OMP_MASK_TARGET | GFC_OMP_MASK_TEAMS | GFC_OMP_MASK_DISTRIBUTE
    6500                 :             :              | GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_DO;
    6501                 :          43 :       innermost = GFC_OMP_SPLIT_DO;
    6502                 :          43 :       break;
    6503                 :          29 :     case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
    6504                 :          29 :       mask = GFC_OMP_MASK_TARGET | GFC_OMP_MASK_TEAMS | GFC_OMP_MASK_DISTRIBUTE
    6505                 :             :              | GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_DO | GFC_OMP_MASK_SIMD;
    6506                 :          29 :       innermost = GFC_OMP_SPLIT_SIMD;
    6507                 :          29 :       break;
    6508                 :          16 :     case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD:
    6509                 :          16 :       mask = GFC_OMP_MASK_TARGET | GFC_OMP_MASK_TEAMS
    6510                 :             :              | GFC_OMP_MASK_DISTRIBUTE | GFC_OMP_MASK_SIMD;
    6511                 :          16 :       innermost = GFC_OMP_SPLIT_SIMD;
    6512                 :          16 :       break;
    6513                 :          10 :     case EXEC_OMP_TARGET_TEAMS_LOOP:
    6514                 :          10 :       mask = GFC_OMP_MASK_TARGET | GFC_OMP_MASK_TEAMS | GFC_OMP_MASK_DO;
    6515                 :          10 :       innermost = GFC_OMP_SPLIT_DO;
    6516                 :          10 :       break;
    6517                 :           8 :     case EXEC_OMP_MASKED_TASKLOOP:
    6518                 :           8 :       mask = GFC_OMP_MASK_MASKED | GFC_OMP_MASK_TASKLOOP;
    6519                 :           8 :       innermost = GFC_OMP_SPLIT_TASKLOOP;
    6520                 :           8 :       break;
    6521                 :           0 :     case EXEC_OMP_MASTER_TASKLOOP:
    6522                 :           0 :     case EXEC_OMP_TASKLOOP:
    6523                 :           0 :       innermost = GFC_OMP_SPLIT_TASKLOOP;
    6524                 :           0 :       break;
    6525                 :          22 :     case EXEC_OMP_MASKED_TASKLOOP_SIMD:
    6526                 :          22 :       mask = GFC_OMP_MASK_MASKED | GFC_OMP_MASK_TASKLOOP | GFC_OMP_MASK_SIMD;
    6527                 :          22 :       innermost = GFC_OMP_SPLIT_SIMD;
    6528                 :          22 :       break;
    6529                 :          45 :     case EXEC_OMP_MASTER_TASKLOOP_SIMD:
    6530                 :          45 :     case EXEC_OMP_TASKLOOP_SIMD:
    6531                 :          45 :       mask = GFC_OMP_MASK_TASKLOOP | GFC_OMP_MASK_SIMD;
    6532                 :          45 :       innermost = GFC_OMP_SPLIT_SIMD;
    6533                 :          45 :       break;
    6534                 :         121 :     case EXEC_OMP_TEAMS:
    6535                 :         121 :       innermost = GFC_OMP_SPLIT_TEAMS;
    6536                 :         121 :       break;
    6537                 :          14 :     case EXEC_OMP_TEAMS_DISTRIBUTE:
    6538                 :          14 :       mask = GFC_OMP_MASK_TEAMS | GFC_OMP_MASK_DISTRIBUTE;
    6539                 :          14 :       innermost = GFC_OMP_SPLIT_DISTRIBUTE;
    6540                 :          14 :       break;
    6541                 :          32 :     case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO:
    6542                 :          32 :       mask = GFC_OMP_MASK_TEAMS | GFC_OMP_MASK_DISTRIBUTE
    6543                 :             :              | GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_DO;
    6544                 :          32 :       innermost = GFC_OMP_SPLIT_DO;
    6545                 :          32 :       break;
    6546                 :          56 :     case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
    6547                 :          56 :       mask = GFC_OMP_MASK_TEAMS | GFC_OMP_MASK_DISTRIBUTE
    6548                 :             :              | GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_DO | GFC_OMP_MASK_SIMD;
    6549                 :          56 :       innermost = GFC_OMP_SPLIT_SIMD;
    6550                 :          56 :       break;
    6551                 :          37 :     case EXEC_OMP_TEAMS_DISTRIBUTE_SIMD:
    6552                 :          37 :       mask = GFC_OMP_MASK_TEAMS | GFC_OMP_MASK_DISTRIBUTE | GFC_OMP_MASK_SIMD;
    6553                 :          37 :       innermost = GFC_OMP_SPLIT_SIMD;
    6554                 :          37 :       break;
    6555                 :             :     case EXEC_OMP_TEAMS_LOOP:
    6556                 :             :       mask = GFC_OMP_MASK_TEAMS | GFC_OMP_MASK_DO;
    6557                 :             :       innermost = GFC_OMP_SPLIT_DO;
    6558                 :             :       break;
    6559                 :           0 :     default:
    6560                 :           0 :       gcc_unreachable ();
    6561                 :             :     }
    6562                 :        3313 :   if (mask == 0)
    6563                 :             :     {
    6564                 :        1371 :       clausesa[innermost] = *code->ext.omp_clauses;
    6565                 :        1371 :       return;
    6566                 :             :     }
    6567                 :             :   /* Loops are similar to DO but still a bit different.  */
    6568                 :        1948 :   switch (code->op)
    6569                 :             :     {
    6570                 :          34 :     case EXEC_OMP_LOOP:
    6571                 :          34 :     case EXEC_OMP_PARALLEL_LOOP:
    6572                 :          34 :     case EXEC_OMP_TEAMS_LOOP:
    6573                 :          34 :     case EXEC_OMP_TARGET_PARALLEL_LOOP:
    6574                 :          34 :     case EXEC_OMP_TARGET_TEAMS_LOOP:
    6575                 :          34 :       is_loop = true;
    6576                 :        1948 :     default:
    6577                 :        1948 :       break;
    6578                 :             :     }
    6579                 :        1948 :   if (code->ext.omp_clauses != NULL)
    6580                 :             :     {
    6581                 :        1948 :       if (mask & GFC_OMP_MASK_TARGET)
    6582                 :             :         {
    6583                 :             :           /* First the clauses that are unique to some constructs.  */
    6584                 :         287 :           clausesa[GFC_OMP_SPLIT_TARGET].lists[OMP_LIST_MAP]
    6585                 :         287 :             = code->ext.omp_clauses->lists[OMP_LIST_MAP];
    6586                 :         287 :           clausesa[GFC_OMP_SPLIT_TARGET].lists[OMP_LIST_IS_DEVICE_PTR]
    6587                 :         287 :             = code->ext.omp_clauses->lists[OMP_LIST_IS_DEVICE_PTR];
    6588                 :         287 :           clausesa[GFC_OMP_SPLIT_TARGET].lists[OMP_LIST_HAS_DEVICE_ADDR]
    6589                 :         287 :             = code->ext.omp_clauses->lists[OMP_LIST_HAS_DEVICE_ADDR];
    6590                 :         287 :           clausesa[GFC_OMP_SPLIT_TARGET].device
    6591                 :         287 :             = code->ext.omp_clauses->device;
    6592                 :         287 :           clausesa[GFC_OMP_SPLIT_TARGET].thread_limit
    6593                 :         287 :             = code->ext.omp_clauses->thread_limit;
    6594                 :         287 :           clausesa[GFC_OMP_SPLIT_TARGET].lists[OMP_LIST_USES_ALLOCATORS]
    6595                 :         287 :             = code->ext.omp_clauses->lists[OMP_LIST_USES_ALLOCATORS];
    6596                 :        2009 :           for (int i = 0; i < OMP_DEFAULTMAP_CAT_NUM; i++)
    6597                 :        1722 :             clausesa[GFC_OMP_SPLIT_TARGET].defaultmap[i]
    6598                 :        1722 :               = code->ext.omp_clauses->defaultmap[i];
    6599                 :         287 :           clausesa[GFC_OMP_SPLIT_TARGET].if_exprs[OMP_IF_TARGET]
    6600                 :         287 :             = code->ext.omp_clauses->if_exprs[OMP_IF_TARGET];
    6601                 :             :           /* And this is copied to all.  */
    6602                 :         287 :           clausesa[GFC_OMP_SPLIT_TARGET].if_expr
    6603                 :         287 :             = code->ext.omp_clauses->if_expr;
    6604                 :         287 :           clausesa[GFC_OMP_SPLIT_TARGET].nowait
    6605                 :         287 :             = code->ext.omp_clauses->nowait;
    6606                 :             :         }
    6607                 :        1948 :       if (mask & GFC_OMP_MASK_TEAMS)
    6608                 :             :         {
    6609                 :             :           /* First the clauses that are unique to some constructs.  */
    6610                 :         320 :           clausesa[GFC_OMP_SPLIT_TEAMS].num_teams_lower
    6611                 :         320 :             = code->ext.omp_clauses->num_teams_lower;
    6612                 :         320 :           clausesa[GFC_OMP_SPLIT_TEAMS].num_teams_upper
    6613                 :         320 :             = code->ext.omp_clauses->num_teams_upper;
    6614                 :         320 :           clausesa[GFC_OMP_SPLIT_TEAMS].thread_limit
    6615                 :         320 :             = code->ext.omp_clauses->thread_limit;
    6616                 :             :           /* Shared and default clauses are allowed on parallel, teams
    6617                 :             :              and taskloop.  */
    6618                 :         320 :           clausesa[GFC_OMP_SPLIT_TEAMS].lists[OMP_LIST_SHARED]
    6619                 :         320 :             = code->ext.omp_clauses->lists[OMP_LIST_SHARED];
    6620                 :         320 :           clausesa[GFC_OMP_SPLIT_TEAMS].default_sharing
    6621                 :         320 :             = code->ext.omp_clauses->default_sharing;
    6622                 :             :         }
    6623                 :        1948 :       if (mask & GFC_OMP_MASK_DISTRIBUTE)
    6624                 :             :         {
    6625                 :             :           /* First the clauses that are unique to some constructs.  */
    6626                 :         346 :           clausesa[GFC_OMP_SPLIT_DISTRIBUTE].dist_sched_kind
    6627                 :         346 :             = code->ext.omp_clauses->dist_sched_kind;
    6628                 :         346 :           clausesa[GFC_OMP_SPLIT_DISTRIBUTE].dist_chunk_size
    6629                 :         346 :             = code->ext.omp_clauses->dist_chunk_size;
    6630                 :             :           /* Duplicate collapse.  */
    6631                 :         346 :           clausesa[GFC_OMP_SPLIT_DISTRIBUTE].collapse
    6632                 :         346 :             = code->ext.omp_clauses->collapse;
    6633                 :         346 :           clausesa[GFC_OMP_SPLIT_DISTRIBUTE].order_concurrent
    6634                 :         346 :             = code->ext.omp_clauses->order_concurrent;
    6635                 :         346 :           clausesa[GFC_OMP_SPLIT_DISTRIBUTE].order_unconstrained
    6636                 :         346 :             = code->ext.omp_clauses->order_unconstrained;
    6637                 :         346 :           clausesa[GFC_OMP_SPLIT_DISTRIBUTE].order_reproducible
    6638                 :         346 :             = code->ext.omp_clauses->order_reproducible;
    6639                 :             :         }
    6640                 :        1948 :       if (mask & GFC_OMP_MASK_PARALLEL)
    6641                 :             :         {
    6642                 :             :           /* First the clauses that are unique to some constructs.  */
    6643                 :        1514 :           clausesa[GFC_OMP_SPLIT_PARALLEL].lists[OMP_LIST_COPYIN]
    6644                 :        1514 :             = code->ext.omp_clauses->lists[OMP_LIST_COPYIN];
    6645                 :        1514 :           clausesa[GFC_OMP_SPLIT_PARALLEL].num_threads
    6646                 :        1514 :             = code->ext.omp_clauses->num_threads;
    6647                 :        1514 :           clausesa[GFC_OMP_SPLIT_PARALLEL].proc_bind
    6648                 :        1514 :             = code->ext.omp_clauses->proc_bind;
    6649                 :             :           /* Shared and default clauses are allowed on parallel, teams
    6650                 :             :              and taskloop.  */
    6651                 :        1514 :           clausesa[GFC_OMP_SPLIT_PARALLEL].lists[OMP_LIST_SHARED]
    6652                 :        1514 :             = code->ext.omp_clauses->lists[OMP_LIST_SHARED];
    6653                 :        1514 :           clausesa[GFC_OMP_SPLIT_PARALLEL].default_sharing
    6654                 :        1514 :             = code->ext.omp_clauses->default_sharing;
    6655                 :        1514 :           clausesa[GFC_OMP_SPLIT_PARALLEL].if_exprs[OMP_IF_PARALLEL]
    6656                 :        1514 :             = code->ext.omp_clauses->if_exprs[OMP_IF_PARALLEL];
    6657                 :             :           /* And this is copied to all.  */
    6658                 :        1514 :           clausesa[GFC_OMP_SPLIT_PARALLEL].if_expr
    6659                 :        1514 :             = code->ext.omp_clauses->if_expr;
    6660                 :             :         }
    6661                 :        1948 :       if (mask & GFC_OMP_MASK_MASKED)
    6662                 :          79 :         clausesa[GFC_OMP_SPLIT_MASKED].filter = code->ext.omp_clauses->filter;
    6663                 :        1948 :       if ((mask & GFC_OMP_MASK_DO) && !is_loop)
    6664                 :             :         {
    6665                 :             :           /* First the clauses that are unique to some constructs.  */
    6666                 :        1507 :           clausesa[GFC_OMP_SPLIT_DO].ordered
    6667                 :        1507 :             = code->ext.omp_clauses->ordered;
    6668                 :        1507 :           clausesa[GFC_OMP_SPLIT_DO].orderedc
    6669                 :        1507 :             = code->ext.omp_clauses->orderedc;
    6670                 :        1507 :           clausesa[GFC_OMP_SPLIT_DO].sched_kind
    6671                 :        1507 :             = code->ext.omp_clauses->sched_kind;
    6672                 :        1507 :           if (innermost == GFC_OMP_SPLIT_SIMD)
    6673                 :         532 :             clausesa[GFC_OMP_SPLIT_DO].sched_simd
    6674                 :         532 :               = code->ext.omp_clauses->sched_simd;
    6675                 :        1507 :           clausesa[GFC_OMP_SPLIT_DO].sched_monotonic
    6676                 :        1507 :             = code->ext.omp_clauses->sched_monotonic;
    6677                 :        1507 :           clausesa[GFC_OMP_SPLIT_DO].sched_nonmonotonic
    6678                 :        1507 :             = code->ext.omp_clauses->sched_nonmonotonic;
    6679                 :        1507 :           clausesa[GFC_OMP_SPLIT_DO].chunk_size
    6680                 :        1507 :             = code->ext.omp_clauses->chunk_size;
    6681                 :        1507 :           clausesa[GFC_OMP_SPLIT_DO].nowait
    6682                 :        1507 :             = code->ext.omp_clauses->nowait;
    6683                 :             :         }
    6684                 :        1541 :       if (mask & GFC_OMP_MASK_DO)
    6685                 :             :         {
    6686                 :        1541 :           clausesa[GFC_OMP_SPLIT_DO].bind
    6687                 :        1541 :             = code->ext.omp_clauses->bind;
    6688                 :             :           /* Duplicate collapse.  */
    6689                 :        1541 :           clausesa[GFC_OMP_SPLIT_DO].collapse
    6690                 :        1541 :             = code->ext.omp_clauses->collapse;
    6691                 :        1541 :           clausesa[GFC_OMP_SPLIT_DO].order_concurrent
    6692                 :        1541 :             = code->ext.omp_clauses->order_concurrent;
    6693                 :        1541 :           clausesa[GFC_OMP_SPLIT_DO].order_unconstrained
    6694                 :        1541 :             = code->ext.omp_clauses->order_unconstrained;
    6695                 :        1541 :           clausesa[GFC_OMP_SPLIT_DO].order_reproducible
    6696                 :        1541 :             = code->ext.omp_clauses->order_reproducible;
    6697                 :             :         }
    6698                 :        1948 :       if (mask & GFC_OMP_MASK_SIMD)
    6699                 :             :         {
    6700                 :         809 :           clausesa[GFC_OMP_SPLIT_SIMD].safelen_expr
    6701                 :         809 :             = code->ext.omp_clauses->safelen_expr;
    6702                 :         809 :           clausesa[GFC_OMP_SPLIT_SIMD].simdlen_expr
    6703                 :         809 :             = code->ext.omp_clauses->simdlen_expr;
    6704                 :         809 :           clausesa[GFC_OMP_SPLIT_SIMD].lists[OMP_LIST_ALIGNED]
    6705                 :         809 :             = code->ext.omp_clauses->lists[OMP_LIST_ALIGNED];
    6706                 :             :           /* Duplicate collapse.  */
    6707                 :         809 :           clausesa[GFC_OMP_SPLIT_SIMD].collapse
    6708                 :         809 :             = code->ext.omp_clauses->collapse;
    6709                 :         809 :           clausesa[GFC_OMP_SPLIT_SIMD].if_exprs[OMP_IF_SIMD]
    6710                 :         809 :             = code->ext.omp_clauses->if_exprs[OMP_IF_SIMD];
    6711                 :         809 :           clausesa[GFC_OMP_SPLIT_SIMD].order_concurrent
    6712                 :         809 :             = code->ext.omp_clauses->order_concurrent;
    6713                 :         809 :           clausesa[GFC_OMP_SPLIT_SIMD].order_unconstrained
    6714                 :         809 :             = code->ext.omp_clauses->order_unconstrained;
    6715                 :         809 :           clausesa[GFC_OMP_SPLIT_SIMD].order_reproducible
    6716                 :         809 :             = code->ext.omp_clauses->order_reproducible;
    6717                 :             :           /* And this is copied to all.  */
    6718                 :         809 :           clausesa[GFC_OMP_SPLIT_SIMD].if_expr
    6719                 :         809 :             = code->ext.omp_clauses->if_expr;
    6720                 :             :         }
    6721                 :        1948 :       if (mask & GFC_OMP_MASK_TASKLOOP)
    6722                 :             :         {
    6723                 :             :           /* First the clauses that are unique to some constructs.  */
    6724                 :         159 :           clausesa[GFC_OMP_SPLIT_TASKLOOP].nogroup
    6725                 :         159 :             = code->ext.omp_clauses->nogroup;
    6726                 :         159 :           clausesa[GFC_OMP_SPLIT_TASKLOOP].grainsize
    6727                 :         159 :             = code->ext.omp_clauses->grainsize;
    6728                 :         159 :           clausesa[GFC_OMP_SPLIT_TASKLOOP].grainsize_strict
    6729                 :         159 :             = code->ext.omp_clauses->grainsize_strict;
    6730                 :         159 :           clausesa[GFC_OMP_SPLIT_TASKLOOP].num_tasks
    6731                 :         159 :             = code->ext.omp_clauses->num_tasks;
    6732                 :         159 :           clausesa[GFC_OMP_SPLIT_TASKLOOP].num_tasks_strict
    6733                 :         159 :             = code->ext.omp_clauses->num_tasks_strict;
    6734                 :         159 :           clausesa[GFC_OMP_SPLIT_TASKLOOP].priority
    6735                 :         159 :             = code->ext.omp_clauses->priority;
    6736                 :         159 :           clausesa[GFC_OMP_SPLIT_TASKLOOP].final_expr
    6737                 :         159 :             = code->ext.omp_clauses->final_expr;
    6738                 :         159 :           clausesa[GFC_OMP_SPLIT_TASKLOOP].untied
    6739                 :         159 :             = code->ext.omp_clauses->untied;
    6740                 :         159 :           clausesa[GFC_OMP_SPLIT_TASKLOOP].mergeable
    6741                 :         159 :             = code->ext.omp_clauses->mergeable;
    6742                 :         159 :           clausesa[GFC_OMP_SPLIT_TASKLOOP].if_exprs[OMP_IF_TASKLOOP]
    6743                 :         159 :             = code->ext.omp_clauses->if_exprs[OMP_IF_TASKLOOP];
    6744                 :             :           /* And this is copied to all.  */
    6745                 :         159 :           clausesa[GFC_OMP_SPLIT_TASKLOOP].if_expr
    6746                 :         159 :             = code->ext.omp_clauses->if_expr;
    6747                 :             :           /* Shared and default clauses are allowed on parallel, teams
    6748                 :             :              and taskloop.  */
    6749                 :         159 :           clausesa[GFC_OMP_SPLIT_TASKLOOP].lists[OMP_LIST_SHARED]
    6750                 :         159 :             = code->ext.omp_clauses->lists[OMP_LIST_SHARED];
    6751                 :         159 :           clausesa[GFC_OMP_SPLIT_TASKLOOP].default_sharing
    6752                 :         159 :             = code->ext.omp_clauses->default_sharing;
    6753                 :             :           /* Duplicate collapse.  */
    6754                 :         159 :           clausesa[GFC_OMP_SPLIT_TASKLOOP].collapse
    6755                 :         159 :             = code->ext.omp_clauses->collapse;
    6756                 :             :         }
    6757                 :             :       /* Private clause is supported on all constructs but master/masked,
    6758                 :             :          it is enough to put it on the innermost one except for master/masked.  For
    6759                 :             :          !$ omp parallel do put it on parallel though,
    6760                 :             :          as that's what we did for OpenMP 3.1.  */
    6761                 :        1948 :       clausesa[((innermost == GFC_OMP_SPLIT_DO && !is_loop)
    6762                 :             :                 || code->op == EXEC_OMP_PARALLEL_MASTER
    6763                 :         973 :                 || code->op == EXEC_OMP_PARALLEL_MASKED)
    6764                 :         962 :                ? (int) GFC_OMP_SPLIT_PARALLEL
    6765                 :        2910 :                : innermost].lists[OMP_LIST_PRIVATE]
    6766                 :        1948 :         = code->ext.omp_clauses->lists[OMP_LIST_PRIVATE];
    6767                 :             :       /* Firstprivate clause is supported on all constructs but
    6768                 :             :          simd and masked/master.  Put it on the outermost of those and duplicate
    6769                 :             :          on parallel and teams.  */
    6770                 :        1948 :       if (mask & GFC_OMP_MASK_TARGET)
    6771                 :         287 :         gfc_add_firstprivate_if_unmapped (&clausesa[GFC_OMP_SPLIT_TARGET],
    6772                 :             :                                           code->ext.omp_clauses);
    6773                 :        1948 :       if (mask & GFC_OMP_MASK_TEAMS)
    6774                 :         320 :         clausesa[GFC_OMP_SPLIT_TEAMS].lists[OMP_LIST_FIRSTPRIVATE]
    6775                 :         320 :           = code->ext.omp_clauses->lists[OMP_LIST_FIRSTPRIVATE];
    6776                 :        1628 :       else if (mask & GFC_OMP_MASK_DISTRIBUTE)
    6777                 :         105 :         clausesa[GFC_OMP_SPLIT_DISTRIBUTE].lists[OMP_LIST_FIRSTPRIVATE]
    6778                 :         105 :           = code->ext.omp_clauses->lists[OMP_LIST_FIRSTPRIVATE];
    6779                 :        1948 :       if (mask & GFC_OMP_MASK_TASKLOOP)
    6780                 :         159 :         clausesa[GFC_OMP_SPLIT_TASKLOOP].lists[OMP_LIST_FIRSTPRIVATE]
    6781                 :         159 :           = code->ext.omp_clauses->lists[OMP_LIST_FIRSTPRIVATE];
    6782                 :        1948 :       if ((mask & GFC_OMP_MASK_PARALLEL)
    6783                 :             :           && !(mask & GFC_OMP_MASK_TASKLOOP))
    6784                 :        1430 :         clausesa[GFC_OMP_SPLIT_PARALLEL].lists[OMP_LIST_FIRSTPRIVATE]
    6785                 :        1430 :           = code->ext.omp_clauses->lists[OMP_LIST_FIRSTPRIVATE];
    6786                 :         518 :       else if ((mask & GFC_OMP_MASK_DO) && !is_loop)
    6787                 :         126 :         clausesa[GFC_OMP_SPLIT_DO].lists[OMP_LIST_FIRSTPRIVATE]
    6788                 :         126 :           = code->ext.omp_clauses->lists[OMP_LIST_FIRSTPRIVATE];
    6789                 :             :       /* Lastprivate is allowed on distribute, do, simd, taskloop and loop.
    6790                 :             :          In parallel do{, simd} we actually want to put it on
    6791                 :             :          parallel rather than do.  */
    6792                 :        1948 :       if (mask & GFC_OMP_MASK_DISTRIBUTE)
    6793                 :         346 :         clausesa[GFC_OMP_SPLIT_DISTRIBUTE].lists[OMP_LIST_LASTPRIVATE]
    6794                 :         346 :           = code->ext.omp_clauses->lists[OMP_LIST_LASTPRIVATE];
    6795                 :        1948 :       if (mask & GFC_OMP_MASK_TASKLOOP)
    6796                 :         159 :         clausesa[GFC_OMP_SPLIT_TASKLOOP].lists[OMP_LIST_LASTPRIVATE]
    6797                 :         159 :           = code->ext.omp_clauses->lists[OMP_LIST_LASTPRIVATE];
    6798                 :        1948 :       if ((mask & GFC_OMP_MASK_PARALLEL) && !is_loop
    6799                 :        1496 :           && !(mask & GFC_OMP_MASK_TASKLOOP))
    6800                 :        1412 :         clausesa[GFC_OMP_SPLIT_PARALLEL].lists[OMP_LIST_LASTPRIVATE]
    6801                 :        1412 :           = code->ext.omp_clauses->lists[OMP_LIST_LASTPRIVATE];
    6802                 :         536 :       else if (mask & GFC_OMP_MASK_DO)
    6803                 :         160 :         clausesa[GFC_OMP_SPLIT_DO].lists[OMP_LIST_LASTPRIVATE]
    6804                 :         160 :           = code->ext.omp_clauses->lists[OMP_LIST_LASTPRIVATE];
    6805                 :        1948 :       if (mask & GFC_OMP_MASK_SIMD)
    6806                 :         809 :         clausesa[GFC_OMP_SPLIT_SIMD].lists[OMP_LIST_LASTPRIVATE]
    6807                 :         809 :           = code->ext.omp_clauses->lists[OMP_LIST_LASTPRIVATE];
    6808                 :             :       /* Reduction is allowed on simd, do, parallel, teams, taskloop, and loop.
    6809                 :             :          Duplicate it on all of them, but
    6810                 :             :          - omit on do if parallel is present;
    6811                 :             :          - omit on task and parallel if loop is present;
    6812                 :             :          additionally, inscan applies to do/simd only.  */
    6813                 :        7792 :       for (int i = OMP_LIST_REDUCTION; i <= OMP_LIST_REDUCTION_TASK; i++)
    6814                 :             :         {
    6815                 :        5844 :           if (mask & GFC_OMP_MASK_TASKLOOP
    6816                 :         477 :               && i != OMP_LIST_REDUCTION_INSCAN)
    6817                 :         318 :             clausesa[GFC_OMP_SPLIT_TASKLOOP].lists[i]
    6818                 :         318 :               = code->ext.omp_clauses->lists[i];
    6819                 :        5844 :           if (mask & GFC_OMP_MASK_TEAMS
    6820                 :         960 :               && i != OMP_LIST_REDUCTION_INSCAN
    6821                 :         960 :               && !is_loop)
    6822                 :         608 :             clausesa[GFC_OMP_SPLIT_TEAMS].lists[i]
    6823                 :         608 :               = code->ext.omp_clauses->lists[i];
    6824                 :        5844 :           if (mask & GFC_OMP_MASK_PARALLEL
    6825                 :        4542 :               && i != OMP_LIST_REDUCTION_INSCAN
    6826                 :        3028 :               && !(mask & GFC_OMP_MASK_TASKLOOP)
    6827                 :        2860 :               && !is_loop)
    6828                 :        2824 :             clausesa[GFC_OMP_SPLIT_PARALLEL].lists[i]
    6829                 :        2824 :               = code->ext.omp_clauses->lists[i];
    6830                 :        3020 :           else if (mask & GFC_OMP_MASK_DO)
    6831                 :        1861 :             clausesa[GFC_OMP_SPLIT_DO].lists[i]
    6832                 :        1861 :               = code->ext.omp_clauses->lists[i];
    6833                 :        5844 :           if (mask & GFC_OMP_MASK_SIMD)
    6834                 :        2427 :             clausesa[GFC_OMP_SPLIT_SIMD].lists[i]
    6835                 :        2427 :               = code->ext.omp_clauses->lists[i];
    6836                 :             :         }
    6837                 :        1948 :       if (mask & GFC_OMP_MASK_TARGET)
    6838                 :         287 :         clausesa[GFC_OMP_SPLIT_TARGET].lists[OMP_LIST_IN_REDUCTION]
    6839                 :         287 :           = code->ext.omp_clauses->lists[OMP_LIST_IN_REDUCTION];
    6840                 :        1948 :       if (mask & GFC_OMP_MASK_TASKLOOP)
    6841                 :         159 :         clausesa[GFC_OMP_SPLIT_TASKLOOP].lists[OMP_LIST_IN_REDUCTION]
    6842                 :         159 :           = code->ext.omp_clauses->lists[OMP_LIST_IN_REDUCTION];
    6843                 :             :       /* Linear clause is supported on do and simd,
    6844                 :             :          put it on the innermost one.  */
    6845                 :        1948 :       clausesa[innermost].lists[OMP_LIST_LINEAR]
    6846                 :        1948 :         = code->ext.omp_clauses->lists[OMP_LIST_LINEAR];
    6847                 :             :     }
    6848                 :             :    /* Propagate firstprivate/lastprivate/reduction vars to
    6849                 :             :       shared (parallel, teams) and map-tofrom (target).  */
    6850                 :        1948 :    if (mask & GFC_OMP_MASK_TARGET)
    6851                 :         287 :      gfc_add_clause_implicitly (&clausesa[GFC_OMP_SPLIT_TARGET],
    6852                 :             :                                 code->ext.omp_clauses, true, false);
    6853                 :        1948 :    if ((mask & GFC_OMP_MASK_PARALLEL) && innermost != GFC_OMP_MASK_PARALLEL)
    6854                 :        1514 :      gfc_add_clause_implicitly (&clausesa[GFC_OMP_SPLIT_PARALLEL],
    6855                 :             :                                 code->ext.omp_clauses, false,
    6856                 :        1514 :                                 mask & GFC_OMP_MASK_DO);
    6857                 :        1948 :    if (mask & GFC_OMP_MASK_TEAMS && innermost != GFC_OMP_MASK_TEAMS)
    6858                 :         320 :      gfc_add_clause_implicitly (&clausesa[GFC_OMP_SPLIT_TEAMS],
    6859                 :             :                                 code->ext.omp_clauses, false, false);
    6860                 :        1948 :    if (((mask & (GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_DO))
    6861                 :             :         == (GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_DO))
    6862                 :        1399 :        && !is_loop)
    6863                 :        1381 :     clausesa[GFC_OMP_SPLIT_DO].nowait = true;
    6864                 :             : 
    6865                 :             :    /* Distribute allocate clause to do, parallel, distribute, teams, target
    6866                 :             :       and taskloop.  The code below iterates over variables in the
    6867                 :             :       allocate list and checks if that available is also in any
    6868                 :             :       privatization clause on those construct.  If yes, then we add it
    6869                 :             :       to the list of 'allocate'ed variables for that construct.  If a
    6870                 :             :       variable is found in none of them then we issue an error.  */
    6871                 :             : 
    6872                 :        1948 :    if (code->ext.omp_clauses->lists[OMP_LIST_ALLOCATE])
    6873                 :             :      {
    6874                 :             :        gfc_omp_namelist *alloc_nl, *priv_nl;
    6875                 :             :        gfc_omp_namelist *tails[GFC_OMP_SPLIT_NUM];
    6876                 :         102 :        for (alloc_nl = code->ext.omp_clauses->lists[OMP_LIST_ALLOCATE];
    6877                 :         177 :            alloc_nl; alloc_nl = alloc_nl->next)
    6878                 :             :          {
    6879                 :             :            bool found = false;
    6880                 :         714 :            for (int i = GFC_OMP_SPLIT_DO; i <= GFC_OMP_SPLIT_TASKLOOP; i++)
    6881                 :             :              {
    6882                 :             :                gfc_omp_namelist *p;
    6883                 :             :                int list;
    6884                 :       20808 :                for (list = 0; list < OMP_LIST_NUM; list++)
    6885                 :             :                  {
    6886                 :       20196 :                    switch (list)
    6887                 :             :                    {
    6888                 :        5508 :                      case OMP_LIST_PRIVATE:
    6889                 :        5508 :                      case OMP_LIST_FIRSTPRIVATE:
    6890                 :        5508 :                      case OMP_LIST_LASTPRIVATE:
    6891                 :        5508 :                      case OMP_LIST_REDUCTION:
    6892                 :        5508 :                      case OMP_LIST_REDUCTION_INSCAN:
    6893                 :        5508 :                      case OMP_LIST_REDUCTION_TASK:
    6894                 :        5508 :                      case OMP_LIST_IN_REDUCTION:
    6895                 :        5508 :                      case OMP_LIST_TASK_REDUCTION:
    6896                 :        5508 :                      case OMP_LIST_LINEAR:
    6897                 :        5982 :                        for (priv_nl = clausesa[i].lists[list]; priv_nl;
    6898                 :         474 :                             priv_nl = priv_nl->next)
    6899                 :         474 :                          if (alloc_nl->sym == priv_nl->sym)
    6900                 :             :                            {
    6901                 :         129 :                              found = true;
    6902                 :         129 :                              p = gfc_get_omp_namelist ();
    6903                 :         129 :                              p->sym = alloc_nl->sym;
    6904                 :         129 :                              p->expr = alloc_nl->expr;
    6905                 :         129 :                              p->u.align = alloc_nl->u.align;
    6906                 :         129 :                              p->u2.allocator = alloc_nl->u2.allocator;
    6907                 :         129 :                              p->where = alloc_nl->where;
    6908                 :         129 :                              if (clausesa[i].lists[OMP_LIST_ALLOCATE] == NULL)
    6909                 :             :                                {
    6910                 :         107 :                                  clausesa[i].lists[OMP_LIST_ALLOCATE] = p;
    6911                 :         107 :                                  tails[i] = p;
    6912                 :             :                                }
    6913                 :             :                              else
    6914                 :             :                                {
    6915                 :          22 :                                  tails[i]->next = p;
    6916                 :          22 :                                  tails[i] = tails[i]->next;
    6917                 :             :                                }
    6918                 :             :                            }
    6919                 :             :                        break;
    6920                 :             :                      default:
    6921                 :             :                        break;