https://gcc.gnu.org/g:7fa90e26160fe4138e529effebd33b053e2fa46f
commit 7fa90e26160fe4138e529effebd33b053e2fa46f Author: Mikael Morin <[email protected]> Date: Wed Oct 29 12:55:34 2025 +0100 fortran: array descriptor: Move accessor functions to a separate file 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. Diff: --- 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(-) 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 cd137212260f..ce3d85eae10e 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" #include "cgraph.h" /* For cgraph_node::add_new_function. */ #include "function.h" /* For push_struct_function. */ @@ -214,23 +215,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 @@ -243,294 +227,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 345a9752dddc..83297bccb134 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 419de2c63cf2..b76f13cc8f2c 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 000000000000..649ff2415db2 --- /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 000000000000..142499f07ec9 --- /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 2e88e65b6b87..29a4d758d8a9 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 91c0301c522c..e23a5329a1a2 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 9360bddb30a7..770e934ce441 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 69a70d7138cf..2b2cef7e8ab9 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 0e82d2a4e9ac..8f4a5f9ac8b1 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 47396c3cbab1..f67c69e60f44 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:
