]> git.ipfire.org Git - thirdparty/gcc.git/commitdiff
Some naming fixes; fix handling of coarrays which are components.
authorThomas Koenig <tkoenig@gcc.gnu.org>
Mon, 9 Nov 2020 20:06:28 +0000 (21:06 +0100)
committerThomas Koenig <tkoenig@gcc.gnu.org>
Mon, 9 Nov 2020 20:06:28 +0000 (21:06 +0100)
gcc/fortran/ChangeLog:

* resolve.c (fixup_shared_coarray_args): Symbol does not
have to have a codimension.
* trans-array.c (gfc_native_coarray_add_this_image_offset):
Rename to...
(cas_add_this_image_offset): this.
(cas_array_ref): New function.
(gfc_conv_ss_descriptor): Use it; use cas_add_this_image_offset.
(gfc_conv_array_ref): Likewise.
(gfc_native_coarray_get_allocation_type): Rename to...
(gfc_cas_get_allocation_type): this.
(gfc_allocate_native_coarray): Rename to...
(gfc_allocate_shared_coarray): this.
(gfc_array_allocate): Use new functionn names.
(gfc_get_dataptr_offset): Use cas_array_ref; fix logic.
* trans-array.h (gfc_native_coarray_get_allocation_type): Rename
prototype to...
(gfc_cas_get_allocation_type): this.
(gfc_allocate_native_coarray): Rename prototype to...
(gfc_allocate_shared_coarray): this.
* trans-decl.c (gfc_trans_native_coarray): Rename to...
(gfc_trans_shared_coarray): This. Use changed function names.
(gfc_trans_native_coarray_static): Rename to...
(gfc_trans_shared_coarray_static): this.
(gfc_trans_native_coarray_inline): Rename to...
(gfc_trans_shared_coarray_inline): this.
(gfc_trans_deferred_vars): Use new function names.
(gfc_create_module_variable): Use new function names.
* trans-stmt.c (gfc_trans_deallocate): Likewise.

gcc/fortran/resolve.c
gcc/fortran/trans-array.c
gcc/fortran/trans-array.h
gcc/fortran/trans-decl.c
gcc/fortran/trans-stmt.c

index d54bd5807fd5880aa06a3ae3b8c512a91eb22f89..e359c2083c45803206eaf20b528d14f7b220c572 100644 (file)
@@ -3614,7 +3614,6 @@ fixup_shared_coarray_args (gfc_symbol *sym, gfc_actual_arglist *actual)
       if (a->expr == NULL || f->sym == NULL)
        continue;
       if (a->expr->expr_type == EXPR_VARIABLE
-         && a->expr->symtree->n.sym->attr.codimension
          && f->sym->attr.codimension)
        {
          gfc_ref *r;
index af346e4ec6208644b42a73e14d7939d49c008e08..28de4ba4ad07ba76626689a769390a63b1d69803 100644 (file)
@@ -2962,9 +2962,8 @@ gfc_add_strides (tree expr, tree desc, int beg, int end)
                         + sum (remaining codimension offsets)
    If offset is a pointer, we also need to multiply it by the size.  */
 static tree
-gfc_native_coarray_add_this_image_offset (tree offset, tree desc,
-                                        gfc_array_ref *ar, int is_pointer,
-                                        int subtract)
+cas_add_this_image_offset (tree offset, tree desc, gfc_array_ref *ar,
+                          int is_pointer, int subtract)
 {
   tree tmp, off;
   /* Calculate the actual offset.  */
@@ -2995,6 +2994,28 @@ gfc_native_coarray_add_this_image_offset (tree offset, tree desc,
                            offset, off);
 }
 
+/* Return the array ref of the coarray, NULL otherwise.  */
+
+static gfc_ref *
+cas_array_ref (gfc_ref *ref)
+{
+  gcc_assert (flag_coarray = GFC_FCOARRAY_SHARED);
+
+  for (; ref; ref = ref->next)
+    {
+      if (ref->type == REF_ARRAY)
+       {
+         if (ref->u.ar.dimen_type[ref->u.ar.dimen + ref->u.ar.codimen - 1]
+             == DIMEN_THIS_IMAGE
+             && !ref->u.ar.shared_coarray_arg)
+           return ref;
+         else
+           return NULL;
+       }
+    }
+  return NULL;
+}
+
 /* Translate expressions for the descriptor and data pointer of a SS.  */
 /*GCC ARRAYS*/
 
@@ -3040,10 +3061,12 @@ gfc_conv_ss_descriptor (stmtblock_t * block, gfc_ss * ss, int base)
       /* If we have a native coarray with implied this_image (), add the
         appropriate offset to the data pointer.  */
       ref = ss_info->expr->ref;
-      if (flag_coarray == GFC_FCOARRAY_SHARED && ref && ref->type == REF_ARRAY
-         && ref->u.ar.dimen_type[ref->u.ar.dimen + ref->u.ar.codimen - 1]
-            == DIMEN_THIS_IMAGE)
-        tmp = gfc_native_coarray_add_this_image_offset (tmp, se.expr, &ref->u.ar, 1, 1);
+      if (flag_coarray == GFC_FCOARRAY_SHARED)
+       {
+         gfc_ref *co_ref = cas_array_ref (ref);
+         if (co_ref)
+           tmp = cas_add_this_image_offset (tmp, se.expr,&co_ref->u.ar, 1, 1);
+       }
       /* If this is a variable or address of a variable we use it directly.
          Otherwise we must evaluate it now to avoid breaking dependency
         analysis by pulling the expressions for elemental array indices
@@ -3839,7 +3862,7 @@ gfc_conv_array_ref (gfc_se * se, gfc_array_ref * ar, gfc_expr *expr,
     }
 
   if (flag_coarray == GFC_FCOARRAY_SHARED && need_impl_this_image)
-    offset = gfc_native_coarray_add_this_image_offset (offset, se->expr, ar, 0, 0);
+    offset = cas_add_this_image_offset (offset, se->expr, ar, 0, 0);
 
   if (!integer_zerop (cst_offset))
     offset = fold_build2_loc (input_location, PLUS_EXPR,
@@ -5903,7 +5926,7 @@ retrieve_last_ref (gfc_ref **ref_in, gfc_ref **prev_ref_in)
 }
 
 int
-gfc_native_coarray_get_allocation_type (gfc_symbol * sym)
+gfc_cas_get_allocation_type (gfc_symbol * sym)
 {
   bool is_lock_type, is_event_type;
   is_lock_type = sym->ts.type == BT_DERIVED
@@ -5923,7 +5946,7 @@ gfc_native_coarray_get_allocation_type (gfc_symbol * sym)
 }
 
 void
-gfc_allocate_native_coarray (stmtblock_t *b, tree decl, tree size, int corank,
+gfc_allocate_shared_coarray (stmtblock_t *b, tree decl, tree size, int corank,
                            int alloc_type)
 {
   gfc_add_expr_to_block (b,
@@ -6136,8 +6159,8 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree status, tree errmsg,
       tree elem_size
            = size_in_bytes (gfc_get_element_type (TREE_TYPE(se->expr)));
       int alloc_type
-            = gfc_native_coarray_get_allocation_type (expr->symtree->n.sym);
-      gfc_allocate_native_coarray (&elseblock, se->expr, elem_size,
+            = gfc_cas_get_allocation_type (expr->symtree->n.sym);
+      gfc_allocate_shared_coarray (&elseblock, se->expr, elem_size,
                                   ref->u.ar.as->corank, alloc_type);
     }
   /* The allocatable variant takes the old pointer as first argument.  */
@@ -7068,13 +7091,12 @@ gfc_get_dataptr_offset (stmtblock_t *block, tree parm, tree desc, tree offset,
     }
 
   /* If it's a coarray with implicit this_image, add that to the offset.  */
-  ref = expr->ref;
-  if (flag_coarray == GFC_FCOARRAY_SHARED && ref && ref->type == REF_ARRAY
-      && ref->u.ar.dimen_type[ref->u.ar.dimen + ref->u.ar.codimen - 1]
-         == DIMEN_THIS_IMAGE
-      && !ref->u.ar.shared_coarray_arg)
-    offset = gfc_native_coarray_add_this_image_offset (offset, desc,
-                                                      &ref->u.ar, 0, 1);
+  if (flag_coarray == GFC_FCOARRAY_SHARED)
+    {
+      gfc_ref *co_ref = cas_array_ref (expr->ref);
+      if (co_ref)
+       offset = cas_add_this_image_offset (offset, desc, &co_ref->u.ar, 0, 1);
+    }
 
   tmp = build_array_ref (desc, offset, NULL, NULL);
 
@@ -7091,11 +7113,7 @@ gfc_get_dataptr_offset (stmtblock_t *block, tree parm, tree desc, tree offset,
              ref = ref->next;
              break;
            }
-         else if (flag_coarray == GFC_FCOARRAY_SHARED && ref->type == REF_ARRAY &&
-                   ref->u.ar.dimen_type[ref->u.ar.dimen +ref->u.ar.codimen -1]
-                     == DIMEN_THIS_IMAGE)
-           tmp = gfc_native_coarray_add_this_image_offset (tmp, desc, &ref->u.ar, 0, 1);
-       }
+        }
 
       /* Calculate the offset for each subsequent subreference.  */
       for (; ref; ref = ref->next)
@@ -7158,10 +7176,7 @@ gfc_get_dataptr_offset (stmtblock_t *block, tree parm, tree desc, tree offset,
                                             gfc_array_index_type, stride, itmp);
                  stride = gfc_evaluate_now (stride, block);
                }
-             if (flag_coarray == GFC_FCOARRAY_SHARED &&
-                   ref->u.ar.dimen_type[ref->u.ar.dimen + ref->u.ar.codimen -1]
-                     == DIMEN_THIS_IMAGE)
-               tmp = gfc_native_coarray_add_this_image_offset (tmp, desc, &ref->u.ar, 0, 1);
+
              /* Apply the index to obtain the array element.  */
              tmp = gfc_build_array_ref (tmp, index, NULL);
              break;
index d0b05aa2b749390a62284ff8647c134fe0a4ec18..66f59bb068ba0be15b4ecaaf0ba407c201d16df9 100644 (file)
@@ -29,9 +29,9 @@ enum gfc_coarray_allocation_type {
   GFC_NCA_EVENT_COARRAY
 };
 
-int gfc_native_coarray_get_allocation_type (gfc_symbol *);
+int gfc_cas_get_allocation_type (gfc_symbol *);
 
-void gfc_allocate_native_coarray (stmtblock_t *, tree, tree, int, int);
+void gfc_allocate_shared_coarray (stmtblock_t *, tree, tree, int, int);
 
 /* Allow the bounds of a loop to be set from a callee's array spec.  */
 void gfc_set_loop_bounds_from_array_spec (gfc_interface_mapping *,
index 4f5b8f0fd1b749a681d77e9729172f035ee57b0a..91a5dca0c7f0c8564b249e924b2d1f201f5a0bc9 100644 (file)
@@ -4666,7 +4666,7 @@ get_proc_result (gfc_symbol* sym)
 
 
 void
-gfc_trans_native_coarray (stmtblock_t * init, stmtblock_t *cleanup, gfc_symbol * sym)
+gfc_trans_shared_coarray (stmtblock_t * init, stmtblock_t *cleanup, gfc_symbol * sym)
 {
   tree tmp, decl;
   /* All unused, but needed as arguments.  */
@@ -4680,7 +4680,7 @@ gfc_trans_native_coarray (stmtblock_t * init, stmtblock_t *cleanup, gfc_symbol *
   TREE_STATIC(decl) = 1;
 
   /* Tell the library to handle arrays of locks and event types seperatly.  */
-  alloc_type = gfc_native_coarray_get_allocation_type (sym);
+  alloc_type = gfc_cas_get_allocation_type (sym);
 
   if (init)
     {
@@ -4691,7 +4691,7 @@ gfc_trans_native_coarray (stmtblock_t * init, stmtblock_t *cleanup, gfc_symbol *
                           NULL_TREE, true, NULL, &element_size);
       gfc_conv_descriptor_offset_set (init, decl, offset);
       elem_size = size_in_bytes (gfc_get_element_type (TREE_TYPE(decl)));
-      gfc_allocate_native_coarray (init, decl, elem_size, sym->as->corank,
+      gfc_allocate_shared_coarray (init, decl, elem_size, sym->as->corank,
                                  alloc_type);
     }
 
@@ -4711,23 +4711,23 @@ static void
 generate_coarray_constructor_function (tree *, tree *);
 
 static void
-gfc_trans_native_coarray_static (gfc_symbol * sym)
+gfc_trans_shared_coarray_static (gfc_symbol * sym)
 {
   tree save_fn_decl, fndecl;
   generate_coarray_constructor_function (&save_fn_decl, &fndecl);
-  gfc_trans_native_coarray (&caf_init_block, NULL, sym);
+  gfc_trans_shared_coarray (&caf_init_block, NULL, sym);
   finish_coarray_constructor_function (&save_fn_decl, &fndecl);
 }
 
 static void
-gfc_trans_native_coarray_inline (gfc_wrapped_block * block, gfc_symbol * sym)
+gfc_trans_shared_coarray_inline (gfc_wrapped_block * block, gfc_symbol * sym)
 {
   stmtblock_t init, cleanup;
 
   gfc_init_block (&init);
   gfc_init_block (&cleanup);
 
-  gfc_trans_native_coarray (&init, &cleanup, sym);
+  gfc_trans_shared_coarray (&init, &cleanup, sym);
 
   gfc_add_init_cleanup (block, gfc_finish_block (&init), gfc_finish_block (&cleanup));
 }
@@ -5043,7 +5043,7 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, gfc_wrapped_block * block)
              else if (flag_coarray == GFC_FCOARRAY_SHARED
                       && sym->attr.codimension)
                {
-                 gfc_trans_native_coarray_inline (block, sym);
+                 gfc_trans_shared_coarray_inline (block, sym);
                }
              else
                {
@@ -5538,7 +5538,7 @@ gfc_create_module_variable (gfc_symbol * sym)
 
   if (flag_coarray == GFC_FCOARRAY_SHARED && sym->attr.codimension
       && !sym->attr.allocatable)
-    gfc_trans_native_coarray_static (sym);
+    gfc_trans_shared_coarray_static (sym);
 
   gfc_module_add_decl (cur_module, decl);
 
index b2bd8e6e9b72ddcc02ece13ad1d17e6f5ac9d1c7..368165e69f9408bf1e3d585b1f06fbac54daba07 100644 (file)
@@ -7339,7 +7339,7 @@ gfc_trans_deallocate (gfc_code *code)
          if (ref && ref->type == REF_ARRAY && ref->u.ar.codimen)
            {
              gfc_symbol *sym = expr->symtree->n.sym;
-             int alloc_type = gfc_native_coarray_get_allocation_type (sym);
+             int alloc_type = gfc_cas_get_allocation_type (sym);
               tmp = build_call_expr_loc (input_location,
                                        gfor_fndecl_cas_coarray_free,
                                        2, gfc_build_addr_expr (pvoid_type_node, se.expr),