https://gcc.gnu.org/g:4063ab9957535659b5b41abb4487ff60b8db908b
commit 4063ab9957535659b5b41abb4487ff60b8db908b Author: Mikael Morin <[email protected]> Date: Sat Sep 27 17:05:06 2025 +0200 Introduction champ bytes_counted_strides Diff: --- gcc/fortran/trans-array.cc | 3 +- gcc/fortran/trans-descriptor.cc | 99 ++++++++++++++++++++++++++++++++--------- gcc/fortran/trans-expr.cc | 2 +- gcc/fortran/trans-io.cc | 2 +- gcc/fortran/trans-types.cc | 17 ++++++- gcc/fortran/trans-types.h | 4 +- 6 files changed, 98 insertions(+), 29 deletions(-) diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc index 0163a32ba846..9e8923cd9b5f 100644 --- a/gcc/fortran/trans-array.cc +++ b/gcc/fortran/trans-array.cc @@ -11188,9 +11188,8 @@ gfc_trans_class_array (gfc_symbol * sym, gfc_wrapped_block * block) rank = CLASS_DATA (sym)->as ? (CLASS_DATA (sym)->as->rank) : (0); gcc_assert (rank>=0); - etype = gfc_get_element_type (type); gfc_conv_descriptor_dtype_set (&init, descriptor, - gfc_get_dtype_rank_type (rank, etype)); + gfc_get_dtype (type, &rank)); gfc_add_init_cleanup (block, gfc_finish_block (&init), NULL_TREE); input_location = loc; diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc index 11a2a0627b02..913348d38623 100644 --- a/gcc/fortran/trans-descriptor.cc +++ b/gcc/fortran/trans-descriptor.cc @@ -185,7 +185,8 @@ enum dtype_subfield GFC_DTYPE_VERSION, GFC_DTYPE_RANK, GFC_DTYPE_TYPE, - GFC_DTYPE_ATTRIBUTE + GFC_DTYPE_ATTRIBUTE, + GFC_DTYPE_BYTES_COUNTED_STRIDES }; @@ -468,6 +469,41 @@ gfc_conv_descriptor_type_set (tree desc, int value) } +static tree +get_descriptor_bytes_counted_strides (tree desc) +{ + return get_dtype_comp (desc, GFC_DTYPE_BYTES_COUNTED_STRIDES, short_unsigned_type_node); +} + +static void +gfc_conv_descriptor_bytes_counted_strides_set (stmtblock_t *block, tree desc, tree value) +{ + set_value (block, get_descriptor_bytes_counted_strides (desc), value); +} + +static void +gfc_conv_descriptor_bytes_counted_strides_set (stmtblock_t *block, tree desc, int value) +{ + tree type = TREE_TYPE (desc); + gcc_assert (GFC_DESCRIPTOR_TYPE_P (type)); + gcc_assert (value == 0 || value == 1); + + tree dtype = get_type_field (type, DTYPE_FIELD); + + tree field = get_type_field (TREE_TYPE (dtype), GFC_DTYPE_BYTES_COUNTED_STRIDES); + + tree type_value = build_int_cst (TREE_TYPE (field), value); + gfc_conv_descriptor_bytes_counted_strides_set (block, desc, type_value); +} + +static void +gfc_conv_descriptor_bytes_counted_strides_set (stmtblock_t *block, tree desc) +{ + int value = GFC_BYTES_STRIDES_ARRAY_TYPE_P (TREE_TYPE (desc)); + gfc_conv_descriptor_bytes_counted_strides_set (block, desc, value); +} + + tree gfc_get_descriptor_dimension (tree desc) { @@ -568,7 +604,7 @@ gfc_conv_descriptor_stride_get (tree desc, tree dim) tree gfc_conv_descriptor_stride_units_get (tree desc, tree dim) { - gcc_assert (GFC_BYTES_STRIDES_ARRAY_TYPE_P (TREE_TYPE (desc))); + gcc_assert (!GFC_BYTES_STRIDES_ARRAY_TYPE_P (TREE_TYPE (desc))); return gfc_conv_descriptor_stride_get (desc, dim); } @@ -663,7 +699,8 @@ gfc_conv_descriptor_extent_get (tree desc, tree dim) unknown cases abort. */ tree -gfc_get_dtype_rank_type_slen (int rank, tree etype, tree length) +gfc_get_dtype_rank_type_slen (int rank, tree etype, bool bytes_counted_strides, + tree length) { tree ptype; int n; @@ -768,6 +805,12 @@ gfc_get_dtype_rank_type_slen (int rank, tree etype, tree length) CONSTRUCTOR_APPEND_ELT (v, field, build_int_cst (TREE_TYPE (field), n)); + field = gfc_advance_chain (TYPE_FIELDS (dtype_type_node), + GFC_DTYPE_BYTES_COUNTED_STRIDES); + CONSTRUCTOR_APPEND_ELT (v, field, + build_int_cst (TREE_TYPE (field), + bytes_counted_strides)); + dtype = build_constructor (dtype_type_node, v); return dtype; @@ -775,9 +818,10 @@ gfc_get_dtype_rank_type_slen (int rank, tree etype, tree length) tree -gfc_get_dtype_rank_type (int rank, tree etype) +gfc_get_dtype_rank_type (int rank, tree etype, bool bytes_counted_strides) { - return gfc_get_dtype_rank_type_slen (rank, etype, NULL_TREE); + return gfc_get_dtype_rank_type_slen (rank, etype, bytes_counted_strides, + NULL_TREE); } @@ -957,8 +1001,11 @@ get_descriptor_dtype_value (tree descr, const value_source &src) else rank = -1; - tree etype = gfc_get_element_type (TREE_TYPE (descr)); - return gfc_get_dtype_rank_type_slen (rank, etype, string_length); + tree type = TREE_TYPE (descr); + tree etype = gfc_get_element_type (type); + bool bytes_counted_strides = GFC_BYTES_STRIDES_ARRAY_TYPE_P (type); + return gfc_get_dtype_rank_type_slen (rank, etype, bytes_counted_strides, + string_length); } else if (src.type == STATIC_INIT) { @@ -978,8 +1025,7 @@ get_descriptor_dtype_value (tree descr, const value_source &src) else rank = -1; - tree etype = gfc_get_element_type (TREE_TYPE (descr)); - return gfc_get_dtype_rank_type (rank, etype); + return gfc_get_dtype (TREE_TYPE (descr), &rank); } return NULL_TREE; @@ -1030,6 +1076,9 @@ set_descriptor (descriptor_write &dest, const value_source &src) tree cstr = dest.u.static_init.build (type); DECL_INITIAL (decl) = cstr; } + else if (dtype_value == NULL_TREE) + gfc_conv_descriptor_bytes_counted_strides_set (dest.u.regular_assign.block, + dest.ref); } @@ -1210,8 +1259,10 @@ gfc_create_null_actual_descriptor (stmtblock_t *block, gfc_typespec *ts, tree desc = gfc_create_var (type, "desc"); DECL_ARTIFICIAL (desc) = 1; + bool bytes_strides = GFC_BYTES_STRIDES_ARRAY_TYPE_P (type); gfc_conv_descriptor_dtype_set (block, desc, - gfc_get_dtype_rank_type (rank, etype)); + gfc_get_dtype_rank_type (rank, etype, + bytes_strides)); gfc_conv_descriptor_data_set (block, desc, null_pointer_node); gfc_conv_descriptor_span_set (block, desc, gfc_conv_descriptor_elem_len_get (desc)); @@ -2040,12 +2091,13 @@ void gfc_set_contiguous_descriptor (stmtblock_t *block, tree desc, tree size, tree data_ptr) { + gcc_assert (!GFC_BYTES_STRIDES_ARRAY_TYPE_P (desc)); gfc_conv_descriptor_dtype_set (block, desc, - gfc_get_dtype_rank_type (1, TREE_TYPE (desc))); + gfc_get_dtype_rank_type (1, TREE_TYPE (desc), + false)); gfc_conv_descriptor_lbound_set (block, desc, gfc_index_zero_node, gfc_index_one_node); - gcc_assert (!GFC_BYTES_STRIDES_ARRAY_TYPE_P (desc)); gfc_conv_descriptor_stride_set (block, desc, gfc_index_zero_node, gfc_index_one_node); @@ -2284,10 +2336,9 @@ gfc_set_gfc_from_cfi (stmtblock_t *block, stmtblock_t *block2, tree gfc_desc, tree rank, tree cfi, gfc_symbol *sym, bool do_copy_inout) { /* gfc->dtype = ... (from declaration, not from cfi). */ - tree etype = gfc_get_element_type (TREE_TYPE (gfc_desc)); gfc_conv_descriptor_dtype_set (block, gfc_desc, - gfc_get_dtype_rank_type (sym->as->rank, - etype)); + gfc_get_dtype (TREE_TYPE (gfc_desc), + &sym->as->rank)); /* gfc->data = cfi->base_addr. */ gfc_conv_descriptor_data_set (block, gfc_desc, gfc_get_cfi_desc_base_addr (cfi)); @@ -2637,6 +2688,8 @@ gfc_set_descriptor_for_assign_realloc (stmtblock_t *block, gfc_loopinfo *loop, if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (desc))) gfc_conv_descriptor_span_set (block, desc, elemsize2); + bool bytes_counted_strides = GFC_BYTES_STRIDES_ARRAY_TYPE_P (desc); + /* For deferred character length, the 'size' field of the dtype might have changed so set the dtype. */ if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (desc)) @@ -2648,7 +2701,8 @@ gfc_set_descriptor_for_assign_realloc (stmtblock_t *block, gfc_loopinfo *loop, else type = gfc_typenode_for_spec (&expr1->ts); - tree tmp = gfc_get_dtype_rank_type (expr1->rank,type); + tree tmp = gfc_get_dtype_rank_type (expr1->rank, type, + bytes_counted_strides); gfc_conv_descriptor_dtype_set (block, desc, tmp); } else if (expr1->ts.type == BT_CLASS) @@ -2660,7 +2714,8 @@ gfc_set_descriptor_for_assign_realloc (stmtblock_t *block, gfc_loopinfo *loop, else type = gfc_get_character_type_len (1, elemsize2); - tree tmp = gfc_get_dtype_rank_type (expr2->rank,type); + tree tmp = gfc_get_dtype_rank_type (expr2->rank, type, + bytes_counted_strides); gfc_conv_descriptor_dtype_set (block, desc, tmp); /* Set the _len field as well... */ @@ -2854,6 +2909,8 @@ gfc_descriptor_init_count (tree descriptor, int rank, int corank, type = TREE_TYPE (descriptor); gcc_assert (!GFC_BYTES_STRIDES_ARRAY_TYPE_P (type)); + bool bytes_counted_strides = false; + stride = gfc_index_one_node; offset = gfc_index_zero_node; @@ -2864,8 +2921,8 @@ gfc_descriptor_init_count (tree descriptor, int rank, int corank, && VAR_P (expr->ts.u.cl->backend_decl)) { type = gfc_typenode_for_spec (&expr->ts); - gfc_conv_descriptor_dtype_set (pblock, descriptor, - gfc_get_dtype_rank_type (rank, type)); + tree dtype = gfc_get_dtype_rank_type (rank, type, bytes_counted_strides); + gfc_conv_descriptor_dtype_set (pblock, descriptor, dtype); } else if (expr->ts.type == BT_CHARACTER && expr->ts.deferred @@ -2886,8 +2943,8 @@ gfc_descriptor_init_count (tree descriptor, int rank, int corank, TREE_OPERAND (descriptor, 0), tmp, NULL_TREE); tmp = fold_convert (gfc_charlen_type_node, tmp); type = gfc_get_character_type_len (expr->ts.kind, tmp); - gfc_conv_descriptor_dtype_set (pblock, descriptor, - gfc_get_dtype_rank_type (rank, type)); + tree dtype = gfc_get_dtype_rank_type (rank, type, bytes_counted_strides); + gfc_conv_descriptor_dtype_set (pblock, descriptor, dtype); } else if (expr3_desc && GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (expr3_desc))) gfc_conv_descriptor_dtype_set (pblock, descriptor, diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc index 7d8ea7c7163a..044b9c074823 100644 --- a/gcc/fortran/trans-expr.cc +++ b/gcc/fortran/trans-expr.cc @@ -11644,7 +11644,7 @@ gfc_trans_arrayfunc_assign (gfc_expr * expr1, gfc_expr * expr2) tree tmp2 = gfc_get_symbol_decl (gfc_find_vtab (&expr2->ts)); tmp2 = gfc_build_addr_expr (TREE_TYPE (tmp), tmp2); gfc_add_modify (&se.pre, tmp, tmp2); - dtype = gfc_get_dtype_rank_type (expr1->rank,type); + dtype = gfc_get_dtype_rank_type (expr1->rank, type, false); } fcncall_realloc_result (&se, expr1->rank, dtype); } diff --git a/gcc/fortran/trans-io.cc b/gcc/fortran/trans-io.cc index cc30b00ff8e1..7188c4ab467e 100644 --- a/gcc/fortran/trans-io.cc +++ b/gcc/fortran/trans-io.cc @@ -1737,7 +1737,7 @@ transfer_namelist_element (stmtblock_t * block, const char * var_name, else { dt = gfc_typenode_for_spec (ts); - dtype = gfc_get_dtype_rank_type (0, dt); + dtype = gfc_get_dtype_rank_type (0, dt, false); } /* Build up the arguments for the transfer call. diff --git a/gcc/fortran/trans-types.cc b/gcc/fortran/trans-types.cc index 49a57dd0b3ff..21bb9c524341 100644 --- a/gcc/fortran/trans-types.cc +++ b/gcc/fortran/trans-types.cc @@ -171,8 +171,20 @@ tree get_dtype_type_node (void) suppress_warning (field); field = gfc_add_field_to_struct_1 (dtype_node, get_identifier ("attribute"), - short_integer_type_node, &dtype_chain); + short_unsigned_type_node, &dtype_chain); + DECL_BIT_FIELD (field) = 1; + tree type_size = TYPE_SIZE (TREE_TYPE (field)); + DECL_SIZE (field) = int_const_binop (MINUS_EXPR, type_size, + build_one_cst (TREE_TYPE (type_size))); suppress_warning (field); + + field = gfc_add_field_to_struct_1 (dtype_node, + get_identifier ("bytes_counted_strides"), + short_unsigned_type_node, &dtype_chain); + DECL_BIT_FIELD (field) = 1; + DECL_SIZE (field) = bitsize_int (1); + suppress_warning (field); + gfc_finish_type (dtype_node); TYPE_DECL_SUPPRESS_DEBUG (TYPE_STUB_DECL (dtype_node)) = 1; dtype_type_node = dtype_node; @@ -1714,7 +1726,8 @@ gfc_get_dtype (tree type, int * rank) irnk = (rank) ? (*rank) : (GFC_TYPE_ARRAY_RANK (type)); etype = gfc_get_element_type (type); - dtype = gfc_get_dtype_rank_type (irnk, etype); + dtype = gfc_get_dtype_rank_type (irnk, etype, + GFC_BYTES_STRIDES_ARRAY_TYPE_P (type)); GFC_TYPE_ARRAY_DTYPE (type) = dtype; return dtype; diff --git a/gcc/fortran/trans-types.h b/gcc/fortran/trans-types.h index c9090e5a625c..5189f4966286 100644 --- a/gcc/fortran/trans-types.h +++ b/gcc/fortran/trans-types.h @@ -117,8 +117,8 @@ bool gfc_return_by_reference (gfc_symbol *); bool gfc_is_nodesc_array (gfc_symbol *); /* Return the DTYPE for an array. */ -tree gfc_get_dtype_rank_type_slen (int, tree, tree); -tree gfc_get_dtype_rank_type (int, tree); +tree gfc_get_dtype_rank_type_slen (int, tree, bool, tree); +tree gfc_get_dtype_rank_type (int, tree, bool); tree gfc_get_dtype (tree, int *rank = NULL); tree gfc_get_caf_vector_type (int dim);
