https://gcc.gnu.org/g:e9eccedf9320316151526ff8365357d8be7f2cbc
commit e9eccedf9320316151526ff8365357d8be7f2cbc Author: Mikael Morin <[email protected]> Date: Wed Jun 18 17:31:23 2025 +0200 fortran: array descriptor 1: Move descriptor functions to a separate file This starts a series of patches to refactor initialisation and updates of array descriptors. The current API touching array descriptors is mostly limited to a set of getters and setters to pick the value from or update individual array descriptor fields. But the values of fields are not completely independent of each other. If an upper bound is modified, either the shape changes and the data pointer needs reallocation, or it doesn't and the lower bound should be updated as well and then also the offset. The final goal of the patches is to have more high level functions providing complete array descriptor updates (say shift array bounds in all dimensions) without leaking the detail of the fields that need to be changed. This first patch moves the existing array descriptor functions to a separate file. -- >8 -- 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 (DATA_FIELD, OFFSET_FIELD, DTYPE_FIELD, SPAN_FIELD DIMENSION_FIELD, CAF_TOKEN_FIELD, STRIDE_SUBFIELD, LBOUND_SUBFIELD, UBOUND_SUBFIELD, 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, gfc_build_null_descriptor, gfc_get_descriptor_offsets_for_info): Move to... * trans-descriptor.cc: ... this new file. * trans-array.h (gfc_get_descriptor_offsets_for_info, 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 to... * trans-descriptor.h: ... this new file. * trans-decl.cc: Include trans-descriptor.h. * trans-expr.cc: Likewise. * trans-intrinsic.cc: Likewise. * trans-io.cc: Likewise. * trans-openmp.cc: Likewise. * trans-stmt.cc: Likewise. * trans-types.cc: Likewise. * trans.cc: Likewise. Diff: --- gcc/fortran/Make-lang.in | 7 +- gcc/fortran/trans-array.cc | 389 +----------------------------------- gcc/fortran/trans-array.h | 26 --- gcc/fortran/trans-decl.cc | 1 + gcc/fortran/trans-descriptor.cc | 424 ++++++++++++++++++++++++++++++++++++++++ gcc/fortran/trans-descriptor.h | 57 ++++++ 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-types.cc | 1 + gcc/fortran/trans.cc | 1 + 13 files changed, 494 insertions(+), 417 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 222ded188671..da487259cc6e 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,349 +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 -#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)); -} - - -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. */ @@ -593,51 +251,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. */ diff --git a/gcc/fortran/trans-array.h b/gcc/fortran/trans-array.h index 345a9752dddc..6125301820f7 100644 --- a/gcc/fortran/trans-array.h +++ b/gcc/fortran/trans-array.h @@ -168,32 +168,6 @@ tree gfc_conv_array_ubound (tree, int); 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); - /* CFI descriptor. */ tree gfc_get_cfi_desc_base_addr (tree); tree gfc_get_cfi_desc_elem_len (tree); diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc index c31c75698828..5efed17e86bc 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..0708abeb43c7 --- /dev/null +++ b/gcc/fortran/trans-descriptor.cc @@ -0,0 +1,424 @@ +/* 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. + + 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)); +} + + +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)); +} + + +/******************************************************************************* + * Array descriptor higher level routines. * + ******************************************************************************/ + +/* 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..22e5dbb0e25e --- /dev/null +++ b/gcc/fortran/trans-descriptor.h @@ -0,0 +1,57 @@ +/* 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 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); + +/* Build a null array descriptor constructor. */ +tree gfc_build_null_descriptor (tree type); + +/* 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 *); + +#endif /* GFC_TRANS_DESCRIPTOR_H */ diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc index 21f256b280f4..a9e264fc5599 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 d1c2a80b2775..2c799b80aebc 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 f25335d6bdbd..07d693ca488d 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-types.cc b/gcc/fortran/trans-types.cc index dfdac600c24d..108b481a4187 100644 --- a/gcc/fortran/trans-types.cc +++ b/gcc/fortran/trans-types.cc @@ -36,6 +36,7 @@ along with GCC; see the file COPYING3. If not see #include "trans-types.h" #include "trans-const.h" #include "trans-array.h" +#include "trans-descriptor.h" #include "dwarf2out.h" /* For struct array_descr_info. */ #include "attribs.h" #include "alias.h" 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:
