From: Mikael Morin <[email protected]>
Regression tested on powerpc64le-unknown-linux-gnu. OK for master?
-- >8 --
Move existing descriptor getters and setters to a new file.
gcc/fortran/ChangeLog:
* Make-lang.in (F95_OBJS): Add fortran/trans-descriptor.o to the
list of objects.
* trans-array.cc: Include trans-descriptor.h
(gfc_get_descriptor_field, gfc_conv_descriptor_data_get,
gfc_conv_descriptor_data_set, gfc_conv_descriptor_offset,
gfc_conv_descriptor_offset_get, gfc_conv_descriptor_offset_set,
gfc_conv_descriptor_dtype, gfc_conv_descriptor_span,
gfc_conv_descriptor_span_get, gfc_conv_descriptor_span_set,
gfc_conv_descriptor_rank, gfc_conv_descriptor_version,
gfc_conv_descriptor_elem_len, gfc_conv_descriptor_attribute,
gfc_conv_descriptor_type, gfc_get_descriptor_dimension,
gfc_conv_descriptor_dimension, gfc_conv_descriptor_token,
gfc_conv_descriptor_subfield, gfc_conv_descriptor_stride,
gfc_conv_descriptor_stride_get, gfc_conv_descriptor_stride_set,
gfc_conv_descriptor_lbound, gfc_conv_descriptor_lbound_get,
gfc_conv_descriptor_lbound_set, gfc_conv_descriptor_ubound,
gfc_conv_descriptor_ubound_get, gfc_conv_descriptor_ubound_set):
Move functions ...
* trans-descriptor.cc: ... to this new file.
* trans-array.h (gfc_get_descriptor_offsets_for_info): Fix
long line in declaration.
(gfc_conv_descriptor_data_get, gfc_conv_descriptor_offset_get,
gfc_conv_descriptor_span_get, gfc_conv_descriptor_dtype,
gfc_conv_descriptor_rank, gfc_conv_descriptor_elem_len,
gfc_conv_descriptor_version, gfc_conv_descriptor_attribute,
gfc_conv_descriptor_type, gfc_get_descriptor_dimension,
gfc_conv_descriptor_stride_get, gfc_conv_descriptor_lbound_get,
gfc_conv_descriptor_ubound_get, gfc_conv_descriptor_token,
gfc_conv_descriptor_data_set, gfc_conv_descriptor_offset_set,
gfc_conv_descriptor_span_set, gfc_conv_descriptor_stride_set,
gfc_conv_descriptor_lbound_set, gfc_conv_descriptor_ubound_set):
Move declarations ...
* trans-descriptor.h: ... to this new file.
* trans-decl.cc: Include new header.
* trans-expr.cc: Likewise.
* trans-intrinsic.cc: Likewise.
* trans-io.cc: Likewise.
* trans-openmp.cc: Likewise.
* trans-stmt.cc: Likewise.
* trans.cc: Likewise.
---
gcc/fortran/Make-lang.in | 7 +-
gcc/fortran/trans-array.cc | 306 +--------------------------
gcc/fortran/trans-array.h | 27 +--
gcc/fortran/trans-decl.cc | 1 +
gcc/fortran/trans-descriptor.cc | 360 ++++++++++++++++++++++++++++++++
gcc/fortran/trans-descriptor.h | 49 +++++
gcc/fortran/trans-expr.cc | 1 +
gcc/fortran/trans-intrinsic.cc | 1 +
gcc/fortran/trans-io.cc | 1 +
gcc/fortran/trans-openmp.cc | 1 +
gcc/fortran/trans-stmt.cc | 1 +
gcc/fortran/trans.cc | 1 +
12 files changed, 424 insertions(+), 332 deletions(-)
create mode 100644 gcc/fortran/trans-descriptor.cc
create mode 100644 gcc/fortran/trans-descriptor.h
diff --git a/gcc/fortran/Make-lang.in b/gcc/fortran/Make-lang.in
index 5b2f921bf2e..2ddb0366e9d 100644
--- a/gcc/fortran/Make-lang.in
+++ b/gcc/fortran/Make-lang.in
@@ -63,9 +63,10 @@ F95_PARSER_OBJS = fortran/arith.o fortran/array.o
fortran/bbt.o \
F95_OBJS = $(F95_PARSER_OBJS) $(FORTRAN_TARGET_OBJS) \
fortran/convert.o fortran/dependency.o fortran/f95-lang.o \
fortran/trans.o fortran/trans-array.o fortran/trans-common.o \
- fortran/trans-const.o fortran/trans-decl.o fortran/trans-expr.o \
- fortran/trans-intrinsic.o fortran/trans-io.o fortran/trans-openmp.o \
- fortran/trans-stmt.o fortran/trans-types.o fortran/frontend-passes.o
+ fortran/trans-const.o fortran/trans-decl.o fortran/trans-descriptor.o \
+ fortran/trans-expr.o fortran/trans-intrinsic.o fortran/trans-io.o \
+ fortran/trans-openmp.o fortran/trans-stmt.o fortran/trans-types.o \
+ fortran/frontend-passes.o
fortran_OBJS = $(F95_OBJS) fortran/gfortranspec.o
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index cb40816558e..94e01dfc5e7 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -92,6 +92,7 @@ along with GCC; see the file COPYING3. If not see
#include "trans-array.h"
#include "trans-const.h"
#include "dependency.h"
+#include "trans-descriptor.h"
static bool gfc_get_array_constructor_size (mpz_t *, gfc_constructor_base);
@@ -212,23 +213,6 @@ gfc_get_cfi_dim_sm (tree desc, tree idx)
#undef CFI_DIM_FIELD_EXTENT
#undef CFI_DIM_FIELD_SM
-/* Build expressions to access the members of an array descriptor.
- It's surprisingly easy to mess up here, so never access
- an array descriptor by "brute force", always use these
- functions. This also avoids problems if we change the format
- of an array descriptor.
-
- To understand these magic numbers, look at the comments
- before gfc_build_array_type() in trans-types.cc.
-
- The code within these defines should be the only code which knows the format
- of an array descriptor.
-
- Any code just needing to read obtain the bounds of an array should use
- gfc_conv_array_* rather than the following functions as these will return
- know constant values, and work with arrays which do not have descriptors.
-
- Don't forget to #undef these! */
#define DATA_FIELD 0
#define OFFSET_FIELD 1
@@ -241,294 +225,6 @@ gfc_get_cfi_dim_sm (tree desc, tree idx)
#define LBOUND_SUBFIELD 1
#define UBOUND_SUBFIELD 2
-static tree
-gfc_get_descriptor_field (tree desc, unsigned field_idx)
-{
- tree type = TREE_TYPE (desc);
- gcc_assert (GFC_DESCRIPTOR_TYPE_P (type));
-
- tree field = gfc_advance_chain (TYPE_FIELDS (type), field_idx);
- gcc_assert (field != NULL_TREE);
-
- return fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (field),
- desc, field, NULL_TREE);
-}
-
-/* This provides READ-ONLY access to the data field. The field itself
- doesn't have the proper type. */
-
-tree
-gfc_conv_descriptor_data_get (tree desc)
-{
- tree type = TREE_TYPE (desc);
- if (TREE_CODE (type) == REFERENCE_TYPE)
- gcc_unreachable ();
-
- tree field = gfc_get_descriptor_field (desc, DATA_FIELD);
- return fold_convert (GFC_TYPE_ARRAY_DATAPTR_TYPE (type), field);
-}
-
-/* This provides WRITE access to the data field. */
-
-void
-gfc_conv_descriptor_data_set (stmtblock_t *block, tree desc, tree value)
-{
- tree field = gfc_get_descriptor_field (desc, DATA_FIELD);
- gfc_add_modify (block, field, fold_convert (TREE_TYPE (field), value));
-}
-
-
-static tree
-gfc_conv_descriptor_offset (tree desc)
-{
- tree field = gfc_get_descriptor_field (desc, OFFSET_FIELD);
- gcc_assert (TREE_TYPE (field) == gfc_array_index_type);
- return field;
-}
-
-tree
-gfc_conv_descriptor_offset_get (tree desc)
-{
- return gfc_conv_descriptor_offset (desc);
-}
-
-void
-gfc_conv_descriptor_offset_set (stmtblock_t *block, tree desc,
- tree value)
-{
- tree t = gfc_conv_descriptor_offset (desc);
- gfc_add_modify (block, t, fold_convert (TREE_TYPE (t), value));
-}
-
-
-tree
-gfc_conv_descriptor_dtype (tree desc)
-{
- tree field = gfc_get_descriptor_field (desc, DTYPE_FIELD);
- gcc_assert (TREE_TYPE (field) == get_dtype_type_node ());
- return field;
-}
-
-static tree
-gfc_conv_descriptor_span (tree desc)
-{
- tree field = gfc_get_descriptor_field (desc, SPAN_FIELD);
- gcc_assert (TREE_TYPE (field) == gfc_array_index_type);
- return field;
-}
-
-tree
-gfc_conv_descriptor_span_get (tree desc)
-{
- return gfc_conv_descriptor_span (desc);
-}
-
-void
-gfc_conv_descriptor_span_set (stmtblock_t *block, tree desc,
- tree value)
-{
- tree t = gfc_conv_descriptor_span (desc);
- gfc_add_modify (block, t, fold_convert (TREE_TYPE (t), value));
-}
-
-
-tree
-gfc_conv_descriptor_rank (tree desc)
-{
- tree tmp;
- tree dtype;
-
- dtype = gfc_conv_descriptor_dtype (desc);
- tmp = gfc_advance_chain (TYPE_FIELDS (TREE_TYPE (dtype)), GFC_DTYPE_RANK);
- gcc_assert (tmp != NULL_TREE
- && TREE_TYPE (tmp) == signed_char_type_node);
- return fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (tmp),
- dtype, tmp, NULL_TREE);
-}
-
-
-tree
-gfc_conv_descriptor_version (tree desc)
-{
- tree tmp;
- tree dtype;
-
- dtype = gfc_conv_descriptor_dtype (desc);
- tmp = gfc_advance_chain (TYPE_FIELDS (TREE_TYPE (dtype)), GFC_DTYPE_VERSION);
- gcc_assert (tmp != NULL_TREE
- && TREE_TYPE (tmp) == integer_type_node);
- return fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (tmp),
- dtype, tmp, NULL_TREE);
-}
-
-
-/* Return the element length from the descriptor dtype field. */
-
-tree
-gfc_conv_descriptor_elem_len (tree desc)
-{
- tree tmp;
- tree dtype;
-
- dtype = gfc_conv_descriptor_dtype (desc);
- tmp = gfc_advance_chain (TYPE_FIELDS (TREE_TYPE (dtype)),
- GFC_DTYPE_ELEM_LEN);
- gcc_assert (tmp != NULL_TREE
- && TREE_TYPE (tmp) == size_type_node);
- return fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (tmp),
- dtype, tmp, NULL_TREE);
-}
-
-
-tree
-gfc_conv_descriptor_attribute (tree desc)
-{
- tree tmp;
- tree dtype;
-
- dtype = gfc_conv_descriptor_dtype (desc);
- tmp = gfc_advance_chain (TYPE_FIELDS (TREE_TYPE (dtype)),
- GFC_DTYPE_ATTRIBUTE);
- gcc_assert (tmp!= NULL_TREE
- && TREE_TYPE (tmp) == short_integer_type_node);
- return fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (tmp),
- dtype, tmp, NULL_TREE);
-}
-
-tree
-gfc_conv_descriptor_type (tree desc)
-{
- tree tmp;
- tree dtype;
-
- dtype = gfc_conv_descriptor_dtype (desc);
- tmp = gfc_advance_chain (TYPE_FIELDS (TREE_TYPE (dtype)), GFC_DTYPE_TYPE);
- gcc_assert (tmp!= NULL_TREE
- && TREE_TYPE (tmp) == signed_char_type_node);
- return fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (tmp),
- dtype, tmp, NULL_TREE);
-}
-
-tree
-gfc_get_descriptor_dimension (tree desc)
-{
- tree field = gfc_get_descriptor_field (desc, DIMENSION_FIELD);
- gcc_assert (TREE_CODE (TREE_TYPE (field)) == ARRAY_TYPE
- && TREE_CODE (TREE_TYPE (TREE_TYPE (field))) == RECORD_TYPE);
- return field;
-}
-
-
-static tree
-gfc_conv_descriptor_dimension (tree desc, tree dim)
-{
- tree tmp;
-
- tmp = gfc_get_descriptor_dimension (desc);
-
- return gfc_build_array_ref (tmp, dim, NULL_TREE, true);
-}
-
-
-tree
-gfc_conv_descriptor_token (tree desc)
-{
- gcc_assert (flag_coarray == GFC_FCOARRAY_LIB);
- tree field = gfc_get_descriptor_field (desc, CAF_TOKEN_FIELD);
- /* Should be a restricted pointer - except in the finalization wrapper. */
- gcc_assert (TREE_TYPE (field) == prvoid_type_node
- || TREE_TYPE (field) == pvoid_type_node);
- return field;
-}
-
-static tree
-gfc_conv_descriptor_subfield (tree desc, tree dim, unsigned field_idx)
-{
- tree tmp = gfc_conv_descriptor_dimension (desc, dim);
- tree field = gfc_advance_chain (TYPE_FIELDS (TREE_TYPE (tmp)), field_idx);
- gcc_assert (field != NULL_TREE);
-
- return fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (field),
- tmp, field, NULL_TREE);
-}
-
-static tree
-gfc_conv_descriptor_stride (tree desc, tree dim)
-{
- tree field = gfc_conv_descriptor_subfield (desc, dim, STRIDE_SUBFIELD);
- gcc_assert (TREE_TYPE (field) == gfc_array_index_type);
- return field;
-}
-
-tree
-gfc_conv_descriptor_stride_get (tree desc, tree dim)
-{
- tree type = TREE_TYPE (desc);
- gcc_assert (GFC_DESCRIPTOR_TYPE_P (type));
- if (integer_zerop (dim)
- && (GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_ALLOCATABLE
- || GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_ASSUMED_SHAPE_CONT
- || GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_ASSUMED_RANK_CONT
- || GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_ASSUMED_RANK_ALLOCATABLE
- || GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_ASSUMED_RANK_POINTER_CONT
- || GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_POINTER_CONT))
- return gfc_index_one_node;
-
- return gfc_conv_descriptor_stride (desc, dim);
-}
-
-void
-gfc_conv_descriptor_stride_set (stmtblock_t *block, tree desc,
- tree dim, tree value)
-{
- tree t = gfc_conv_descriptor_stride (desc, dim);
- gfc_add_modify (block, t, fold_convert (TREE_TYPE (t), value));
-}
-
-static tree
-gfc_conv_descriptor_lbound (tree desc, tree dim)
-{
- tree field = gfc_conv_descriptor_subfield (desc, dim, LBOUND_SUBFIELD);
- gcc_assert (TREE_TYPE (field) == gfc_array_index_type);
- return field;
-}
-
-tree
-gfc_conv_descriptor_lbound_get (tree desc, tree dim)
-{
- return gfc_conv_descriptor_lbound (desc, dim);
-}
-
-void
-gfc_conv_descriptor_lbound_set (stmtblock_t *block, tree desc,
- tree dim, tree value)
-{
- tree t = gfc_conv_descriptor_lbound (desc, dim);
- gfc_add_modify (block, t, fold_convert (TREE_TYPE (t), value));
-}
-
-static tree
-gfc_conv_descriptor_ubound (tree desc, tree dim)
-{
- tree field = gfc_conv_descriptor_subfield (desc, dim, UBOUND_SUBFIELD);
- gcc_assert (TREE_TYPE (field) == gfc_array_index_type);
- return field;
-}
-
-tree
-gfc_conv_descriptor_ubound_get (tree desc, tree dim)
-{
- return gfc_conv_descriptor_ubound (desc, dim);
-}
-
-void
-gfc_conv_descriptor_ubound_set (stmtblock_t *block, tree desc,
- tree dim, tree value)
-{
- tree t = gfc_conv_descriptor_ubound (desc, dim);
- gfc_add_modify (block, t, fold_convert (TREE_TYPE (t), value));
-}
-
/* Build a null array descriptor constructor. */
tree
diff --git a/gcc/fortran/trans-array.h b/gcc/fortran/trans-array.h
index 345a9752ddd..83297bccb13 100644
--- a/gcc/fortran/trans-array.h
+++ b/gcc/fortran/trans-array.h
@@ -169,30 +169,9 @@ tree gfc_trans_array_bounds (tree, gfc_symbol *, tree *,
stmtblock_t *);
void gfc_trans_array_cobounds (tree, stmtblock_t *, const gfc_symbol *);
/* Build expressions for accessing components of an array descriptor. */
-void gfc_get_descriptor_offsets_for_info (const_tree, tree *, tree *, tree *,
tree *,
- tree *, tree *, tree *, tree *);
-
-tree gfc_conv_descriptor_data_get (tree);
-tree gfc_conv_descriptor_offset_get (tree);
-tree gfc_conv_descriptor_span_get (tree);
-tree gfc_conv_descriptor_dtype (tree);
-tree gfc_conv_descriptor_rank (tree);
-tree gfc_conv_descriptor_elem_len (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);
-tree gfc_conv_descriptor_stride_get (tree, tree);
-tree gfc_conv_descriptor_lbound_get (tree, tree);
-tree gfc_conv_descriptor_ubound_get (tree, tree);
-tree gfc_conv_descriptor_token (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_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);
-void gfc_conv_descriptor_ubound_set (stmtblock_t *, tree, tree, tree);
+void gfc_get_descriptor_offsets_for_info (const_tree, tree *, tree *, tree *,
+ tree *, tree *, tree *, tree *,
+ tree *);
/* CFI descriptor. */
tree gfc_get_cfi_desc_base_addr (tree);
diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc
index c31c7569882..5efed17e86b 100644
--- a/gcc/fortran/trans-decl.cc
+++ b/gcc/fortran/trans-decl.cc
@@ -44,6 +44,7 @@ along with GCC; see the file COPYING3. If not see
#include "trans-const.h"
/* Only for gfc_trans_code. Shouldn't need to include this. */
#include "trans-stmt.h"
+#include "trans-descriptor.h"
#include "gomp-constants.h"
#include "gimplify.h"
#include "context.h"
diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
new file mode 100644
index 00000000000..649ff2415db
--- /dev/null
+++ b/gcc/fortran/trans-descriptor.cc
@@ -0,0 +1,360 @@
+/* Copyright (C) 2002-2025 Free Software Foundation, Inc.
+
+This file is part of GCC.
+
+GCC is free software; you can redistribute it and/or modify it under
+the terms of the GNU General Public License as published by the Free
+Software Foundation; either version 3, or (at your option) any later
+version.
+
+GCC is distributed in the hope that it will be useful, but WITHOUT ANY
+WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License
+along with GCC; see the file COPYING3. If not see
+<http://www.gnu.org/licenses/>. */
+
+
+#include "config.h"
+#include "system.h"
+#include "coretypes.h"
+#include "tree.h"
+#include "fold-const.h"
+#include "gfortran.h"
+#include "trans.h"
+#include "trans-const.h"
+#include "trans-types.h"
+
+
+/* Array descriptor low level access routines.
+
******************************************************************************/
+
+/* Build expressions to access the members of an array descriptor.
+ It's surprisingly easy to mess up here, so never access
+ an array descriptor by "brute force", always use these
+ functions. This also avoids problems if we change the format
+ of an array descriptor.
+
+ To understand these magic numbers, look at the comments
+ before gfc_build_array_type() in trans-types.cc.
+
+ The code within these defines should be the only code which knows the format
+ of an array descriptor.
+
+ Any code just needing to read obtain the bounds of an array should use
+ gfc_conv_array_* rather than the following functions as these will return
+ know constant values, and work with arrays which do not have descriptors.
+
+ Don't forget to #undef these! */
+
+#define DATA_FIELD 0
+#define OFFSET_FIELD 1
+#define DTYPE_FIELD 2
+#define SPAN_FIELD 3
+#define DIMENSION_FIELD 4
+#define CAF_TOKEN_FIELD 5
+
+#define STRIDE_SUBFIELD 0
+#define LBOUND_SUBFIELD 1
+#define UBOUND_SUBFIELD 2
+
+static tree
+gfc_get_descriptor_field (tree desc, unsigned field_idx)
+{
+ tree type = TREE_TYPE (desc);
+ gcc_assert (GFC_DESCRIPTOR_TYPE_P (type));
+
+ tree field = gfc_advance_chain (TYPE_FIELDS (type), field_idx);
+ gcc_assert (field != NULL_TREE);
+
+ return fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (field),
+ desc, field, NULL_TREE);
+}
+
+/* This provides READ-ONLY access to the data field. The field itself
+ doesn't have the proper type. */
+
+tree
+gfc_conv_descriptor_data_get (tree desc)
+{
+ tree type = TREE_TYPE (desc);
+ if (TREE_CODE (type) == REFERENCE_TYPE)
+ gcc_unreachable ();
+
+ tree field = gfc_get_descriptor_field (desc, DATA_FIELD);
+ return fold_convert (GFC_TYPE_ARRAY_DATAPTR_TYPE (type), field);
+}
+
+/* This provides WRITE access to the data field. */
+
+void
+gfc_conv_descriptor_data_set (stmtblock_t *block, tree desc, tree value)
+{
+ tree field = gfc_get_descriptor_field (desc, DATA_FIELD);
+ gfc_add_modify (block, field, fold_convert (TREE_TYPE (field), value));
+}
+
+
+tree
+gfc_conv_descriptor_offset (tree desc)
+{
+ tree field = gfc_get_descriptor_field (desc, OFFSET_FIELD);
+ gcc_assert (TREE_TYPE (field) == gfc_array_index_type);
+ return field;
+}
+
+tree
+gfc_conv_descriptor_offset_get (tree desc)
+{
+ return gfc_conv_descriptor_offset (desc);
+}
+
+void
+gfc_conv_descriptor_offset_set (stmtblock_t *block, tree desc, tree value)
+{
+ tree t = gfc_conv_descriptor_offset (desc);
+ gfc_add_modify (block, t, fold_convert (TREE_TYPE (t), value));
+}
+
+
+tree
+gfc_conv_descriptor_dtype (tree desc)
+{
+ tree field = gfc_get_descriptor_field (desc, DTYPE_FIELD);
+ gcc_assert (TREE_TYPE (field) == get_dtype_type_node ());
+ return field;
+}
+
+static tree
+gfc_conv_descriptor_span (tree desc)
+{
+ tree field = gfc_get_descriptor_field (desc, SPAN_FIELD);
+ gcc_assert (TREE_TYPE (field) == gfc_array_index_type);
+ return field;
+}
+
+tree
+gfc_conv_descriptor_span_get (tree desc)
+{
+ return gfc_conv_descriptor_span (desc);
+}
+
+void
+gfc_conv_descriptor_span_set (stmtblock_t *block, tree desc, tree value)
+{
+ tree t = gfc_conv_descriptor_span (desc);
+ gfc_add_modify (block, t, fold_convert (TREE_TYPE (t), value));
+}
+
+
+tree
+gfc_conv_descriptor_rank (tree desc)
+{
+ tree tmp;
+ tree dtype;
+
+ dtype = gfc_conv_descriptor_dtype (desc);
+ tmp = gfc_advance_chain (TYPE_FIELDS (TREE_TYPE (dtype)), GFC_DTYPE_RANK);
+ gcc_assert (tmp != NULL_TREE
+ && TREE_TYPE (tmp) == signed_char_type_node);
+ return fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (tmp),
+ dtype, tmp, NULL_TREE);
+}
+
+
+tree
+gfc_conv_descriptor_version (tree desc)
+{
+ tree tmp;
+ tree dtype;
+
+ dtype = gfc_conv_descriptor_dtype (desc);
+ tmp = gfc_advance_chain (TYPE_FIELDS (TREE_TYPE (dtype)), GFC_DTYPE_VERSION);
+ gcc_assert (tmp != NULL_TREE
+ && TREE_TYPE (tmp) == integer_type_node);
+ return fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (tmp),
+ dtype, tmp, NULL_TREE);
+}
+
+
+/* Return the element length from the descriptor dtype field. */
+
+tree
+gfc_conv_descriptor_elem_len (tree desc)
+{
+ tree tmp;
+ tree dtype;
+
+ dtype = gfc_conv_descriptor_dtype (desc);
+ tmp = gfc_advance_chain (TYPE_FIELDS (TREE_TYPE (dtype)),
+ GFC_DTYPE_ELEM_LEN);
+ gcc_assert (tmp != NULL_TREE
+ && TREE_TYPE (tmp) == size_type_node);
+ return fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (tmp),
+ dtype, tmp, NULL_TREE);
+}
+
+
+tree
+gfc_conv_descriptor_attribute (tree desc)
+{
+ tree tmp;
+ tree dtype;
+
+ dtype = gfc_conv_descriptor_dtype (desc);
+ tmp = gfc_advance_chain (TYPE_FIELDS (TREE_TYPE (dtype)),
+ GFC_DTYPE_ATTRIBUTE);
+ gcc_assert (tmp!= NULL_TREE
+ && TREE_TYPE (tmp) == short_integer_type_node);
+ return fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (tmp),
+ dtype, tmp, NULL_TREE);
+}
+
+tree
+gfc_conv_descriptor_type (tree desc)
+{
+ tree tmp;
+ tree dtype;
+
+ dtype = gfc_conv_descriptor_dtype (desc);
+ tmp = gfc_advance_chain (TYPE_FIELDS (TREE_TYPE (dtype)), GFC_DTYPE_TYPE);
+ gcc_assert (tmp!= NULL_TREE
+ && TREE_TYPE (tmp) == signed_char_type_node);
+ return fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (tmp),
+ dtype, tmp, NULL_TREE);
+}
+
+tree
+gfc_get_descriptor_dimension (tree desc)
+{
+ tree field = gfc_get_descriptor_field (desc, DIMENSION_FIELD);
+ gcc_assert (TREE_CODE (TREE_TYPE (field)) == ARRAY_TYPE
+ && TREE_CODE (TREE_TYPE (TREE_TYPE (field))) == RECORD_TYPE);
+ return field;
+}
+
+
+tree
+gfc_conv_descriptor_dimension (tree desc, tree dim)
+{
+ tree tmp;
+
+ tmp = gfc_get_descriptor_dimension (desc);
+
+ return gfc_build_array_ref (tmp, dim, NULL_TREE, true);
+}
+
+
+tree
+gfc_conv_descriptor_token (tree desc)
+{
+ gcc_assert (flag_coarray == GFC_FCOARRAY_LIB);
+ tree field = gfc_get_descriptor_field (desc, CAF_TOKEN_FIELD);
+ /* Should be a restricted pointer - except in the finalization wrapper. */
+ gcc_assert (TREE_TYPE (field) == prvoid_type_node
+ || TREE_TYPE (field) == pvoid_type_node);
+ return field;
+}
+
+static tree
+gfc_conv_descriptor_subfield (tree desc, tree dim, unsigned field_idx)
+{
+ tree tmp = gfc_conv_descriptor_dimension (desc, dim);
+ tree field = gfc_advance_chain (TYPE_FIELDS (TREE_TYPE (tmp)), field_idx);
+ gcc_assert (field != NULL_TREE);
+
+ return fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (field),
+ tmp, field, NULL_TREE);
+}
+
+static tree
+gfc_conv_descriptor_stride (tree desc, tree dim)
+{
+ tree field = gfc_conv_descriptor_subfield (desc, dim, STRIDE_SUBFIELD);
+ gcc_assert (TREE_TYPE (field) == gfc_array_index_type);
+ return field;
+}
+
+tree
+gfc_conv_descriptor_stride_get (tree desc, tree dim)
+{
+ tree type = TREE_TYPE (desc);
+ gcc_assert (GFC_DESCRIPTOR_TYPE_P (type));
+ if (integer_zerop (dim)
+ && (GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_ALLOCATABLE
+ || GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_ASSUMED_SHAPE_CONT
+ || GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_ASSUMED_RANK_CONT
+ || GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_ASSUMED_RANK_ALLOCATABLE
+ || GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_ASSUMED_RANK_POINTER_CONT
+ || GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_POINTER_CONT))
+ return gfc_index_one_node;
+
+ return gfc_conv_descriptor_stride (desc, dim);
+}
+
+void
+gfc_conv_descriptor_stride_set (stmtblock_t *block, tree desc,
+ tree dim, tree value)
+{
+ tree t = gfc_conv_descriptor_stride (desc, dim);
+ gfc_add_modify (block, t, fold_convert (TREE_TYPE (t), value));
+}
+
+static tree
+gfc_conv_descriptor_lbound (tree desc, tree dim)
+{
+ tree field = gfc_conv_descriptor_subfield (desc, dim, LBOUND_SUBFIELD);
+ gcc_assert (TREE_TYPE (field) == gfc_array_index_type);
+ return field;
+}
+
+tree
+gfc_conv_descriptor_lbound_get (tree desc, tree dim)
+{
+ return gfc_conv_descriptor_lbound (desc, dim);
+}
+
+void
+gfc_conv_descriptor_lbound_set (stmtblock_t *block, tree desc,
+ tree dim, tree value)
+{
+ tree t = gfc_conv_descriptor_lbound (desc, dim);
+ gfc_add_modify (block, t, fold_convert (TREE_TYPE (t), value));
+}
+
+static tree
+gfc_conv_descriptor_ubound (tree desc, tree dim)
+{
+ tree field = gfc_conv_descriptor_subfield (desc, dim, UBOUND_SUBFIELD);
+ gcc_assert (TREE_TYPE (field) == gfc_array_index_type);
+ return field;
+}
+
+tree
+gfc_conv_descriptor_ubound_get (tree desc, tree dim)
+{
+ return gfc_conv_descriptor_ubound (desc, dim);
+}
+
+void
+gfc_conv_descriptor_ubound_set (stmtblock_t *block, tree desc,
+ tree dim, tree value)
+{
+ tree t = gfc_conv_descriptor_ubound (desc, dim);
+ gfc_add_modify (block, t, fold_convert (TREE_TYPE (t), value));
+}
+
+
+/* Cleanup those #defines. */
+
+#undef DATA_FIELD
+#undef OFFSET_FIELD
+#undef DTYPE_FIELD
+#undef SPAN_FIELD
+#undef DIMENSION_FIELD
+#undef CAF_TOKEN_FIELD
+#undef STRIDE_SUBFIELD
+#undef LBOUND_SUBFIELD
+#undef UBOUND_SUBFIELD
diff --git a/gcc/fortran/trans-descriptor.h b/gcc/fortran/trans-descriptor.h
new file mode 100644
index 00000000000..142499f07ec
--- /dev/null
+++ b/gcc/fortran/trans-descriptor.h
@@ -0,0 +1,49 @@
+/* Copyright (C) 2002-2025 Free Software Foundation, Inc.
+
+This file is part of GCC.
+
+GCC is free software; you can redistribute it and/or modify it under
+the terms of the GNU General Public License as published by the Free
+Software Foundation; either version 3, or (at your option) any later
+version.
+
+GCC is distributed in the hope that it will be useful, but WITHOUT ANY
+WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License
+along with GCC; see the file COPYING3. If not see
+<http://www.gnu.org/licenses/>. */
+
+#ifndef GFC_TRANS_DESCRIPTOR_H
+#define GFC_TRANS_DESCRIPTOR_H
+
+
+tree gfc_conv_descriptor_dtype (tree);
+tree gfc_conv_descriptor_rank (tree);
+tree gfc_conv_descriptor_version (tree);
+tree gfc_conv_descriptor_elem_len (tree);
+tree gfc_conv_descriptor_attribute (tree);
+tree gfc_conv_descriptor_type (tree);
+tree gfc_get_descriptor_dimension (tree);
+tree gfc_conv_descriptor_dimension (tree, tree);
+tree gfc_conv_descriptor_token (tree);
+tree gfc_conv_descriptor_offset (tree);
+
+tree gfc_conv_descriptor_data_get (tree);
+tree gfc_conv_descriptor_offset_get (tree);
+tree gfc_conv_descriptor_span_get (tree);
+
+tree gfc_conv_descriptor_stride_get (tree, tree);
+tree gfc_conv_descriptor_lbound_get (tree, tree);
+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_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);
+void gfc_conv_descriptor_ubound_set (stmtblock_t *, tree, tree, tree);
+
+#endif /* GFC_TRANS_DESCRIPTOR_H */
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 2e88e65b6b8..29a4d758d8a 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -38,6 +38,7 @@ along with GCC; see the file COPYING3. If not see
#include "trans-const.h"
#include "trans-types.h"
#include "trans-array.h"
+#include "trans-descriptor.h"
/* Only for gfc_trans_assign and gfc_trans_pointer_assign. */
#include "trans-stmt.h"
#include "dependency.h"
diff --git a/gcc/fortran/trans-intrinsic.cc b/gcc/fortran/trans-intrinsic.cc
index 89a03d874ec..930dae6b40b 100644
--- a/gcc/fortran/trans-intrinsic.cc
+++ b/gcc/fortran/trans-intrinsic.cc
@@ -39,6 +39,7 @@ along with GCC; see the file COPYING3. If not see
#include "trans-const.h"
#include "trans-types.h"
#include "trans-array.h"
+#include "trans-descriptor.h"
#include "dependency.h" /* For CAF array alias analysis. */
#include "attribs.h"
#include "realmpfr.h"
diff --git a/gcc/fortran/trans-io.cc b/gcc/fortran/trans-io.cc
index 9360bddb30a..770e934ce44 100644
--- a/gcc/fortran/trans-io.cc
+++ b/gcc/fortran/trans-io.cc
@@ -32,6 +32,7 @@ along with GCC; see the file COPYING3. If not see
#include "trans-array.h"
#include "trans-types.h"
#include "trans-const.h"
+#include "trans-descriptor.h"
#include "options.h"
/* Members of the ioparm structure. */
diff --git a/gcc/fortran/trans-openmp.cc b/gcc/fortran/trans-openmp.cc
index 69a70d7138c..2b2cef7e8ab 100644
--- a/gcc/fortran/trans-openmp.cc
+++ b/gcc/fortran/trans-openmp.cc
@@ -38,6 +38,7 @@ along with GCC; see the file COPYING3. If not see
#include "trans-types.h"
#include "trans-array.h"
#include "trans-const.h"
+#include "trans-descriptor.h"
#include "arith.h"
#include "constructor.h"
#include "gomp-constants.h"
diff --git a/gcc/fortran/trans-stmt.cc b/gcc/fortran/trans-stmt.cc
index 0e82d2a4e9a..8f4a5f9ac8b 100644
--- a/gcc/fortran/trans-stmt.cc
+++ b/gcc/fortran/trans-stmt.cc
@@ -33,6 +33,7 @@ along with GCC; see the file COPYING3. If not see
#include "trans-types.h"
#include "trans-array.h"
#include "trans-const.h"
+#include "trans-descriptor.h"
#include "dependency.h"
typedef struct iter_info
diff --git a/gcc/fortran/trans.cc b/gcc/fortran/trans.cc
index 47396c3cbab..f67c69e60f4 100644
--- a/gcc/fortran/trans.cc
+++ b/gcc/fortran/trans.cc
@@ -33,6 +33,7 @@ along with GCC; see the file COPYING3. If not see
#include "trans-array.h"
#include "trans-types.h"
#include "trans-const.h"
+#include "trans-descriptor.h"
/* Naming convention for backend interface code:
--
2.51.0
