From: Mikael Morin <[email protected]>

Regression tested on powerpc64le-unknown-linux-gnu.  OK for master?

-- >8 --

Add accessor functions to get or set the value of the version field of array
descriptors, and remove from the public API the function giving direct acces
to the field.

gcc/fortran/ChangeLog:

        * trans-descriptor.cc (gfc_conv_descriptor_version): Make static and
        rename ...
        (conv_descriptor_version): ... to this.
        (gfc_conv_descriptor_version_get, gfc_conv_descriptor_version_set):
        New functions.
        * trans-descriptor.h (gfc_conv_descriptor_version): Remove
        declaration.
        (gfc_conv_descriptor_version_get, gfc_conv_descriptor_version_set):
        New declarations.
        * trans.cc (gfc_deallocate_with_status): Use
        gfc_conv_descriptor_version_get to get the value of the version
        field, and gfc_conv_descriptor_version_set to set it.
        * trans-array.cc (gfc_array_allocate, structure_alloc_comps,
        gfc_alloc_allocatable_for_assignment): Likewise.
---
 gcc/fortran/trans-array.cc      | 23 +++++++++++++----------
 gcc/fortran/trans-descriptor.cc | 25 +++++++++++++++++++++++--
 gcc/fortran/trans-descriptor.h  |  3 ++-
 gcc/fortran/trans.cc            |  5 ++---
 4 files changed, 40 insertions(+), 16 deletions(-)

diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 5f47bd8ce3b..cee779697e8 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -6445,10 +6445,11 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree 
status, tree errmsg,
                     build_tree_list (NULL_TREE, alloc),
                     DECL_ATTRIBUTES (omp_alt_alloc));
       omp_alt_alloc = build_call_expr (omp_alt_alloc, 3, align, sz, alloc);
-      succ_add_expr = fold_build2_loc (input_location, MODIFY_EXPR,
-                                      void_type_node,
-                                      gfc_conv_descriptor_version (se->expr),
+      stmtblock_t tmp_block;
+      gfc_init_block (&tmp_block);
+      gfc_conv_descriptor_version_set (&tmp_block, se->expr,
                                       build_int_cst (integer_type_node, 1));
+      succ_add_expr = gfc_finish_block (&tmp_block);
     }
 
   /* The allocatable variant takes the old pointer as first argument.  */
@@ -10622,10 +10623,12 @@ structure_alloc_comps (gfc_symbol * der_type, tree 
decl, tree dest,
                {
                  tree cd, t;
                  if (c->attr.pdt_array)
-                   cd = fold_build2_loc (input_location, EQ_EXPR,
-                                         boolean_type_node,
-                                         gfc_conv_descriptor_version (comp),
-                                         build_int_cst (integer_type_node, 1));
+                   {
+                     tree version = gfc_conv_descriptor_version_get (comp);
+                     cd = fold_build2_loc (input_location, EQ_EXPR,
+                                           boolean_type_node, version,
+                                           build_one_cst (integer_type_node));
+                   }
                  else
                    cd = gfc_omp_call_is_alloc (tmp);
                  t = builtin_decl_explicit (BUILT_IN_GOMP_FREE);
@@ -10635,8 +10638,8 @@ structure_alloc_comps (gfc_symbol * der_type, tree 
decl, tree dest,
                  gfc_init_block (&tblock);
                  gfc_add_expr_to_block (&tblock, t);
                  if (c->attr.pdt_array)
-                   gfc_add_modify (&tblock, gfc_conv_descriptor_version (comp),
-                                   integer_zero_node);
+                   gfc_conv_descriptor_version_set (&tblock, comp,
+                                                    integer_zero_node);
                  tmp = build3_loc (input_location, COND_EXPR, void_type_node,
                                    cd, gfc_finish_block (&tblock),
                                    gfc_call_free (tmp));
@@ -11712,7 +11715,7 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo 
*loop,
        {
          tree cond, omp_tmp;
          cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node,
-                                 gfc_conv_descriptor_version (desc),
+                                 gfc_conv_descriptor_version_get (desc),
                                  build_int_cst (integer_type_node, 1));
          omp_tmp = builtin_decl_explicit (BUILT_IN_GOMP_REALLOC);
          omp_tmp = build_call_expr_loc (input_location, omp_tmp, 4,
diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index 0a1355e3e5f..c02a3fd5282 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -165,8 +165,10 @@ gfc_conv_descriptor_rank (tree desc)
 }
 
 
-tree
-gfc_conv_descriptor_version (tree desc)
+/* Return a reference to descriptor DESC's format version.  */
+
+static tree
+conv_descriptor_version (tree desc)
 {
   tree tmp;
   tree dtype;
@@ -179,6 +181,25 @@ gfc_conv_descriptor_version (tree desc)
                          dtype, tmp, NULL_TREE);
 }
 
+/* Return the value of descriptor DESC's format version.  */
+
+tree
+gfc_conv_descriptor_version_get (tree desc)
+{
+  return conv_descriptor_version (desc);
+}
+
+/* Add code to BLOCK setting to VALUE the descriptor DESC's format version.  */
+
+void
+gfc_conv_descriptor_version_set (stmtblock_t *block, tree desc, tree value)
+{
+  location_t loc = input_location;
+  tree t = conv_descriptor_version (desc);
+  gfc_add_modify_loc (loc, block, t,
+                     fold_convert_loc (loc, TREE_TYPE (t), value));
+}
+
 
 /* Return the element length from the descriptor dtype field.  */
 
diff --git a/gcc/fortran/trans-descriptor.h b/gcc/fortran/trans-descriptor.h
index afc8f5d442e..ec60d7cb656 100644
--- a/gcc/fortran/trans-descriptor.h
+++ b/gcc/fortran/trans-descriptor.h
@@ -22,7 +22,6 @@ along with GCC; see the file COPYING3.  If not see
 
 tree gfc_conv_descriptor_dtype (tree);
 tree gfc_conv_descriptor_rank (tree);
-tree gfc_conv_descriptor_version (tree);
 tree gfc_conv_descriptor_attribute (tree);
 tree gfc_conv_descriptor_type (tree);
 tree gfc_get_descriptor_dimension (tree);
@@ -32,6 +31,7 @@ tree gfc_conv_descriptor_token (tree);
 tree gfc_conv_descriptor_data_get (tree);
 tree gfc_conv_descriptor_offset_get (tree);
 tree gfc_conv_descriptor_elem_len_get (tree);
+tree gfc_conv_descriptor_version_get (tree);
 tree gfc_conv_descriptor_span_get (tree);
 
 tree gfc_conv_descriptor_stride_get (tree, tree);
@@ -41,6 +41,7 @@ tree gfc_conv_descriptor_ubound_get (tree, tree);
 void gfc_conv_descriptor_data_set (stmtblock_t *, tree, tree);
 void gfc_conv_descriptor_offset_set (stmtblock_t *, tree, tree);
 void gfc_conv_descriptor_elem_len_set (stmtblock_t *, tree, tree);
+void gfc_conv_descriptor_version_set (stmtblock_t *, tree, tree);
 void gfc_conv_descriptor_span_set (stmtblock_t *, tree, tree);
 void gfc_conv_descriptor_stride_set (stmtblock_t *, tree, tree, tree);
 void gfc_conv_descriptor_lbound_set (stmtblock_t *, tree, tree, tree);
diff --git a/gcc/fortran/trans.cc b/gcc/fortran/trans.cc
index f67c69e60f4..bd249ae2f87 100644
--- a/gcc/fortran/trans.cc
+++ b/gcc/fortran/trans.cc
@@ -1918,7 +1918,7 @@ gfc_deallocate_with_status (tree pointer, tree status, 
tree errmsg, tree errlen,
          tree cond, omp_tmp;
          if (descr)
            cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node,
-                                   gfc_conv_descriptor_version (descr),
+                                   gfc_conv_descriptor_version_get (descr),
                                    integer_one_node);
          else
            cond = gfc_omp_call_is_alloc (pointer);
@@ -1932,8 +1932,7 @@ gfc_deallocate_with_status (tree pointer, tree status, 
tree errmsg, tree errlen,
       gfc_add_modify (&non_null, pointer, build_int_cst (TREE_TYPE (pointer),
                                                         0));
       if (flag_openmp_allocators && descr)
-       gfc_add_modify (&non_null, gfc_conv_descriptor_version (descr),
-                       integer_zero_node);
+       gfc_conv_descriptor_version_set (&non_null, descr, integer_zero_node);
 
       if (status != NULL_TREE && !integer_zerop (status))
        {
-- 
2.51.0

Reply via email to