Move existing descriptor getters and setters to a new file.
PR fortran/122521
gcc/fortran/ChangeLog:
* Make-lang.in (F95_OBJS): Add fortran/trans-descriptor.o to the
list of objects.
* trans-array.cc: Include new header.
(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.
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
#include "trans-array.h"
#include "trans-const.h"
#include "dependency.h"
+#include "trans-descriptor.h"
#include "cgraph.h" /* For cgraph_node::add_new_function. */
#include "function.h" /* For push_struct_function. */
#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 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
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);
#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"
--- /dev/null
+/* 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
--- /dev/null
+/* 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 */
#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"
#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"
#include "trans-array.h"
#include "trans-types.h"
#include "trans-const.h"
+#include "trans-descriptor.h"
#include "options.h"
/* Members of the ioparm structure. */
#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"
#include "trans-types.h"
#include "trans-array.h"
#include "trans-const.h"
+#include "trans-descriptor.h"
#include "dependency.h"
typedef struct iter_info
#include "trans-array.h"
#include "trans-types.h"
#include "trans-const.h"
+#include "trans-descriptor.h"
/* Naming convention for backend interface code:
projects / thirdparty / gcc.git / commitdiff
