https://gcc.gnu.org/g:ed2b5eb97ccdfe214b7389b9a19fd90977faf96f
commit ed2b5eb97ccdfe214b7389b9a19fd90977faf96f
Author: Mikael Morin <mik...@gcc.gnu.org>
Date: Wed Jun 18 17:31:23 2025 +0200
Déplacement fonctions descripteur vers fichier séparé
Diff:
---
gcc/fortran/Make-lang.in | 7 +-
gcc/fortran/trans-array.cc | 515 +-------------------------------------
gcc/fortran/trans-descriptor.cc | 534 ++++++++++++++++++++++++++++++++++++++++
gcc/fortran/trans-descriptor.h | 67 +++++
4 files changed, 610 insertions(+), 513 deletions(-)
diff --git a/gcc/fortran/Make-lang.in b/gcc/fortran/Make-lang.in
index 5b2f921bf2ef..2ddb0366e9dc 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 960613167f72..8d90bec0d85f 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);
@@ -106,466 +107,6 @@ gfc_array_dataptr_type (tree desc)
return (GFC_TYPE_ARRAY_DATAPTR_TYPE (TREE_TYPE (desc)));
}
-/* Build expressions to access members of the CFI descriptor. */
-#define CFI_FIELD_BASE_ADDR 0
-#define CFI_FIELD_ELEM_LEN 1
-#define CFI_FIELD_VERSION 2
-#define CFI_FIELD_RANK 3
-#define CFI_FIELD_ATTRIBUTE 4
-#define CFI_FIELD_TYPE 5
-#define CFI_FIELD_DIM 6
-
-#define CFI_DIM_FIELD_LOWER_BOUND 0
-#define CFI_DIM_FIELD_EXTENT 1
-#define CFI_DIM_FIELD_SM 2
-
-static tree
-gfc_get_cfi_descriptor_field (tree desc, unsigned field_idx)
-{
- tree type = TREE_TYPE (desc);
- gcc_assert (TREE_CODE (type) == RECORD_TYPE
- && TYPE_FIELDS (type)
- && (strcmp ("base_addr",
- IDENTIFIER_POINTER (DECL_NAME (TYPE_FIELDS (type))))
- == 0));
- 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);
-}
-
-tree
-gfc_get_cfi_desc_base_addr (tree desc)
-{
- return gfc_get_cfi_descriptor_field (desc, CFI_FIELD_BASE_ADDR);
-}
-
-tree
-gfc_get_cfi_desc_elem_len (tree desc)
-{
- return gfc_get_cfi_descriptor_field (desc, CFI_FIELD_ELEM_LEN);
-}
-
-tree
-gfc_get_cfi_desc_version (tree desc)
-{
- return gfc_get_cfi_descriptor_field (desc, CFI_FIELD_VERSION);
-}
-
-tree
-gfc_get_cfi_desc_rank (tree desc)
-{
- return gfc_get_cfi_descriptor_field (desc, CFI_FIELD_RANK);
-}
-
-tree
-gfc_get_cfi_desc_type (tree desc)
-{
- return gfc_get_cfi_descriptor_field (desc, CFI_FIELD_TYPE);
-}
-
-tree
-gfc_get_cfi_desc_attribute (tree desc)
-{
- return gfc_get_cfi_descriptor_field (desc, CFI_FIELD_ATTRIBUTE);
-}
-
-static tree
-gfc_get_cfi_dim_item (tree desc, tree idx, unsigned field_idx)
-{
- tree tmp = gfc_get_cfi_descriptor_field (desc, CFI_FIELD_DIM);
- tmp = gfc_build_array_ref (tmp, idx, NULL_TREE, true);
- 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);
-}
-
-tree
-gfc_get_cfi_dim_lbound (tree desc, tree idx)
-{
- return gfc_get_cfi_dim_item (desc, idx, CFI_DIM_FIELD_LOWER_BOUND);
-}
-
-tree
-gfc_get_cfi_dim_extent (tree desc, tree idx)
-{
- return gfc_get_cfi_dim_item (desc, idx, CFI_DIM_FIELD_EXTENT);
-}
-
-tree
-gfc_get_cfi_dim_sm (tree desc, tree idx)
-{
- return gfc_get_cfi_dim_item (desc, idx, CFI_DIM_FIELD_SM);
-}
-
-#undef CFI_FIELD_BASE_ADDR
-#undef CFI_FIELD_ELEM_LEN
-#undef CFI_FIELD_VERSION
-#undef CFI_FIELD_RANK
-#undef CFI_FIELD_ATTRIBUTE
-#undef CFI_FIELD_TYPE
-#undef CFI_FIELD_DIM
-
-#undef CFI_DIM_FIELD_LOWER_BOUND
-#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
-#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.
-
- TUPLES_P is true if we are generating tuples.
-
- This function gets called through the following macros:
- gfc_conv_descriptor_data_set
- gfc_conv_descriptor_data_set. */
-
-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));
-}
-
-
-/* This provides address access to the data field. This should only be
- used by array allocation, passing this on to the runtime. */
-
-tree
-gfc_conv_descriptor_data_addr (tree desc)
-{
- tree field = gfc_get_descriptor_field (desc, DATA_FIELD);
- return gfc_build_addr_expr (NULL_TREE, field);
-}
-
-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
-gfc_build_null_descriptor (tree type)
-{
- tree field;
- tree tmp;
-
- gcc_assert (GFC_DESCRIPTOR_TYPE_P (type));
- gcc_assert (DATA_FIELD == 0);
- field = TYPE_FIELDS (type);
-
- /* Set a NULL data pointer. */
- tmp = build_constructor_single (type, field, null_pointer_node);
- TREE_CONSTANT (tmp) = 1;
- /* All other fields are ignored. */
-
- return tmp;
-}
-
-
/* Modify a descriptor such that the lbound of a given dimension is the value
specified. This also updates ubound and offset accordingly. */
@@ -603,51 +144,6 @@ gfc_conv_shift_descriptor_lbound (stmtblock_t* block, tree
desc,
}
-/* Obtain offsets for trans-types.cc(gfc_get_array_descr_info). */
-
-void
-gfc_get_descriptor_offsets_for_info (const_tree desc_type, tree *data_off,
- tree *dtype_off, tree *span_off,
- tree *dim_off, tree *dim_size,
- tree *stride_suboff, tree *lower_suboff,
- tree *upper_suboff)
-{
- tree field;
- tree type;
-
- type = TYPE_MAIN_VARIANT (desc_type);
- field = gfc_advance_chain (TYPE_FIELDS (type), DATA_FIELD);
- *data_off = byte_position (field);
- field = gfc_advance_chain (TYPE_FIELDS (type), DTYPE_FIELD);
- *dtype_off = byte_position (field);
- field = gfc_advance_chain (TYPE_FIELDS (type), SPAN_FIELD);
- *span_off = byte_position (field);
- field = gfc_advance_chain (TYPE_FIELDS (type), DIMENSION_FIELD);
- *dim_off = byte_position (field);
- type = TREE_TYPE (TREE_TYPE (field));
- *dim_size = TYPE_SIZE_UNIT (type);
- field = gfc_advance_chain (TYPE_FIELDS (type), STRIDE_SUBFIELD);
- *stride_suboff = byte_position (field);
- field = gfc_advance_chain (TYPE_FIELDS (type), LBOUND_SUBFIELD);
- *lower_suboff = byte_position (field);
- field = gfc_advance_chain (TYPE_FIELDS (type), UBOUND_SUBFIELD);
- *upper_suboff = byte_position (field);
-}
-
-
-/* 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
-
-
/* Mark a SS chain as used. Flags specifies in which loops the SS is used.
flags & 1 = Main loop body.
flags & 2 = temp copy loop. */
@@ -11566,8 +11062,8 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo
*loop,
gfc_index_zero_node);
}
- tmp = gfc_conv_descriptor_offset (desc);
- gfc_add_modify (&loop_pre_block, tmp, gfc_index_zero_node);
+ gfc_conv_descriptor_offset_set (&loop_pre_block, desc,
+ gfc_index_zero_node);
tmp = fold_build2_loc (input_location, EQ_EXPR,
logical_type_node, array1,
@@ -11732,11 +11228,10 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo
*loop,
/* Set the lhs descriptor and scalarizer offsets. For rank > 1,
the array offset is saved and the info.offset is used for a
running offset. Use the saved_offset instead. */
- tmp = gfc_conv_descriptor_offset (desc);
- gfc_add_modify (&fblock, tmp, offset);
+ gfc_conv_descriptor_offset_set (&fblock, desc, offset);
if (linfo->saved_offset
&& VAR_P (linfo->saved_offset))
- gfc_add_modify (&fblock, linfo->saved_offset, tmp);
+ gfc_add_modify (&fblock, linfo->saved_offset, offset);
/* Now set the deltas for the lhs. */
for (n = 0; n < expr1->rank; n++)
diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
new file mode 100644
index 000000000000..30093a74ae58
--- /dev/null
+++ b/gcc/fortran/trans-descriptor.cc
@@ -0,0 +1,534 @@
+/* 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"
+
+
+/* Build expressions to access members of the CFI descriptor. */
+#define CFI_FIELD_BASE_ADDR 0
+#define CFI_FIELD_ELEM_LEN 1
+#define CFI_FIELD_VERSION 2
+#define CFI_FIELD_RANK 3
+#define CFI_FIELD_ATTRIBUTE 4
+#define CFI_FIELD_TYPE 5
+#define CFI_FIELD_DIM 6
+
+#define CFI_DIM_FIELD_LOWER_BOUND 0
+#define CFI_DIM_FIELD_EXTENT 1
+#define CFI_DIM_FIELD_SM 2
+
+static tree
+gfc_get_cfi_descriptor_field (tree desc, unsigned field_idx)
+{
+ tree type = TREE_TYPE (desc);
+ gcc_assert (TREE_CODE (type) == RECORD_TYPE
+ && TYPE_FIELDS (type)
+ && (strcmp ("base_addr",
+ IDENTIFIER_POINTER (DECL_NAME (TYPE_FIELDS (type))))
+ == 0));
+ 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);
+}
+
+tree
+gfc_get_cfi_desc_base_addr (tree desc)
+{
+ return gfc_get_cfi_descriptor_field (desc, CFI_FIELD_BASE_ADDR);
+}
+
+tree
+gfc_get_cfi_desc_elem_len (tree desc)
+{
+ return gfc_get_cfi_descriptor_field (desc, CFI_FIELD_ELEM_LEN);
+}
+
+tree
+gfc_get_cfi_desc_version (tree desc)
+{
+ return gfc_get_cfi_descriptor_field (desc, CFI_FIELD_VERSION);
+}
+
+tree
+gfc_get_cfi_desc_rank (tree desc)
+{
+ return gfc_get_cfi_descriptor_field (desc, CFI_FIELD_RANK);
+}
+
+tree
+gfc_get_cfi_desc_type (tree desc)
+{
+ return gfc_get_cfi_descriptor_field (desc, CFI_FIELD_TYPE);
+}
+
+tree
+gfc_get_cfi_desc_attribute (tree desc)
+{
+ return gfc_get_cfi_descriptor_field (desc, CFI_FIELD_ATTRIBUTE);
+}
+
+static tree
+gfc_get_cfi_dim_item (tree desc, tree idx, unsigned field_idx)
+{
+ tree tmp = gfc_get_cfi_descriptor_field (desc, CFI_FIELD_DIM);
+ tmp = gfc_build_array_ref (tmp, idx, NULL_TREE, true);
+ 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);
+}
+
+tree
+gfc_get_cfi_dim_lbound (tree desc, tree idx)
+{
+ return gfc_get_cfi_dim_item (desc, idx, CFI_DIM_FIELD_LOWER_BOUND);
+}
+
+tree
+gfc_get_cfi_dim_extent (tree desc, tree idx)
+{
+ return gfc_get_cfi_dim_item (desc, idx, CFI_DIM_FIELD_EXTENT);
+}
+
+tree
+gfc_get_cfi_dim_sm (tree desc, tree idx)
+{
+ return gfc_get_cfi_dim_item (desc, idx, CFI_DIM_FIELD_SM);
+}
+
+#undef CFI_FIELD_BASE_ADDR
+#undef CFI_FIELD_ELEM_LEN
+#undef CFI_FIELD_VERSION
+#undef CFI_FIELD_RANK
+#undef CFI_FIELD_ATTRIBUTE
+#undef CFI_FIELD_TYPE
+#undef CFI_FIELD_DIM
+
+#undef CFI_DIM_FIELD_LOWER_BOUND
+#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
+#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.
+
+ TUPLES_P is true if we are generating tuples.
+
+ This function gets called through the following macros:
+ gfc_conv_descriptor_data_set
+ gfc_conv_descriptor_data_set. */
+
+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));
+}
+
+
+/* This provides address access to the data field. This should only be
+ used by array allocation, passing this on to the runtime. */
+
+tree
+gfc_conv_descriptor_data_addr (tree desc)
+{
+ tree field = gfc_get_descriptor_field (desc, DATA_FIELD);
+ return gfc_build_addr_expr (NULL_TREE, field);
+}
+
+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));
+}
+
+
+/* Build a null array descriptor constructor. */
+
+tree
+gfc_build_null_descriptor (tree type)
+{
+ tree field;
+ tree tmp;
+
+ gcc_assert (GFC_DESCRIPTOR_TYPE_P (type));
+ gcc_assert (DATA_FIELD == 0);
+ field = TYPE_FIELDS (type);
+
+ /* Set a NULL data pointer. */
+ tmp = build_constructor_single (type, field, null_pointer_node);
+ TREE_CONSTANT (tmp) = 1;
+ /* All other fields are ignored. */
+
+ return tmp;
+}
+
+
+/* Obtain offsets for trans-types.cc(gfc_get_array_descr_info). */
+
+void
+gfc_get_descriptor_offsets_for_info (const_tree desc_type, tree *data_off,
+ tree *dtype_off, tree *span_off,
+ tree *dim_off, tree *dim_size,
+ tree *stride_suboff, tree *lower_suboff,
+ tree *upper_suboff)
+{
+ tree field;
+ tree type;
+
+ type = TYPE_MAIN_VARIANT (desc_type);
+ field = gfc_advance_chain (TYPE_FIELDS (type), DATA_FIELD);
+ *data_off = byte_position (field);
+ field = gfc_advance_chain (TYPE_FIELDS (type), DTYPE_FIELD);
+ *dtype_off = byte_position (field);
+ field = gfc_advance_chain (TYPE_FIELDS (type), SPAN_FIELD);
+ *span_off = byte_position (field);
+ field = gfc_advance_chain (TYPE_FIELDS (type), DIMENSION_FIELD);
+ *dim_off = byte_position (field);
+ type = TREE_TYPE (TREE_TYPE (field));
+ *dim_size = TYPE_SIZE_UNIT (type);
+ field = gfc_advance_chain (TYPE_FIELDS (type), STRIDE_SUBFIELD);
+ *stride_suboff = byte_position (field);
+ field = gfc_advance_chain (TYPE_FIELDS (type), LBOUND_SUBFIELD);
+ *lower_suboff = byte_position (field);
+ field = gfc_advance_chain (TYPE_FIELDS (type), UBOUND_SUBFIELD);
+ *upper_suboff = byte_position (field);
+}
+
+
+/* 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 000000000000..f60a32c7131c
--- /dev/null
+++ b/gcc/fortran/trans-descriptor.h
@@ -0,0 +1,67 @@
+/* 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/>. */
+
+
+tree gfc_get_cfi_desc_base_addr (tree desc);
+tree gfc_get_cfi_desc_elem_len (tree desc);
+tree gfc_get_cfi_desc_version (tree desc);
+tree gfc_get_cfi_desc_rank (tree desc);
+tree gfc_get_cfi_desc_type (tree desc);
+tree gfc_get_cfi_desc_attribute (tree desc);
+
+tree gfc_get_cfi_dim_lbound (tree desc, tree idx);
+tree gfc_get_cfi_dim_extent (tree desc, tree idx);
+tree gfc_get_cfi_dim_sm (tree desc, tree idx);
+
+
+tree gfc_conv_descriptor_data_addr (tree desc);
+tree gfc_conv_descriptor_dtype (tree desc);
+tree gfc_conv_descriptor_rank (tree desc);
+tree gfc_conv_descriptor_version (tree desc);
+tree gfc_conv_descriptor_elem_len (tree desc);
+tree gfc_conv_descriptor_attribute (tree desc);
+tree gfc_conv_descriptor_type (tree desc);
+tree gfc_get_descriptor_dimension (tree desc);
+tree gfc_conv_descriptor_dimension (tree desc, tree dim);
+tree gfc_conv_descriptor_token (tree desc);
+tree gfc_conv_descriptor_offset (tree desc);
+
+tree gfc_conv_descriptor_data_get (tree desc);
+tree gfc_conv_descriptor_offset_get (tree desc);
+tree gfc_conv_descriptor_span_get (tree desc);
+
+tree gfc_conv_descriptor_stride_get (tree desc, tree dim);
+tree gfc_conv_descriptor_lbound_get (tree desc, tree dim);
+tree gfc_conv_descriptor_ubound_get (tree desc, tree dim);
+
+void gfc_conv_descriptor_data_set (stmtblock_t *block, tree desc, tree value);
+void gfc_conv_descriptor_offset_set (stmtblock_t *block, tree desc, tree
value);
+void gfc_conv_descriptor_span_set (stmtblock_t *block, tree desc, tree value);
+void gfc_conv_descriptor_stride_set (stmtblock_t *block, tree desc, tree dim,
tree value);
+void gfc_conv_descriptor_lbound_set (stmtblock_t *block, tree desc, tree dim,
tree value);
+void gfc_conv_descriptor_ubound_set (stmtblock_t *block, tree desc, tree dim,
tree value);
+
+tree gfc_build_null_descriptor (tree type);
+
+void
+gfc_get_descriptor_offsets_for_info (const_tree desc_type, tree *data_off,
+ tree *dtype_off, tree *span_off,
+ tree *dim_off, tree *dim_size,
+ tree *stride_suboff, tree *lower_suboff,
+ tree *upper_suboff);
+
