[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] Déplacement gfc_copy_sequence_descriptor
https://gcc.gnu.org/g:d29279433aa2fbcd57c06a7a9ca84e09a35c5bba
commit d29279433aa2fbcd57c06a7a9ca84e09a35c5bba
Author: Mikael Morin
Date: Thu Jan 30 21:21:39 2025 +0100
Déplacement gfc_copy_sequence_descriptor
Correction erreur compil'
Diff:
---
gcc/fortran/trans-array.cc | 64 ++
gcc/fortran/trans-array.h | 1 +
gcc/fortran/trans-expr.cc | 64 --
gcc/fortran/trans.h| 1 -
4 files changed, 65 insertions(+), 65 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index a1fb41fc9354..455c9bcd76cc 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -1835,6 +1835,70 @@ gfc_set_descriptor_from_scalar (stmtblock_t *block, tree
desc, tree scalar,
gfc_conv_descriptor_data_set (block, desc, tmp);
}
+int
+gfc_descriptor_rank (tree descriptor)
+{
+ if (TREE_TYPE (descriptor) != NULL_TREE)
+return GFC_TYPE_ARRAY_RANK (TREE_TYPE (descriptor));
+
+ tree dim = gfc_get_descriptor_dimension (descriptor);
+ tree dim_type = TREE_TYPE (dim);
+ gcc_assert (TREE_CODE (dim_type) == ARRAY_TYPE);
+ tree idx_type = TYPE_DOMAIN (dim_type);
+ gcc_assert (TREE_CODE (idx_type) == INTEGER_TYPE);
+ gcc_assert (integer_zerop (TYPE_MIN_VALUE (idx_type)));
+ tree idx_max = TYPE_MAX_VALUE (idx_type);
+ if (idx_max == NULL_TREE)
+return GFC_MAX_DIMENSIONS;
+ wide_int max = wi::to_wide (idx_max);
+ return max.to_shwi () + 1;
+}
+
+
+void
+gfc_copy_sequence_descriptor (stmtblock_t &block, tree lhs_desc, tree rhs_desc,
+ bool assumed_rank_lhs)
+{
+ int lhs_rank = gfc_descriptor_rank (lhs_desc);
+ int rhs_rank = gfc_descriptor_rank (rhs_desc);
+ tree desc;
+
+ if (assumed_rank_lhs || lhs_rank == rhs_rank)
+desc = rhs_desc;
+ else
+{
+ tree arr = gfc_create_var (TREE_TYPE (lhs_desc), "parm");
+ gfc_conv_descriptor_data_set (&block, arr,
+ gfc_conv_descriptor_data_get (rhs_desc));
+ gfc_conv_descriptor_lbound_set (&block, arr, gfc_index_zero_node,
+ gfc_index_zero_node);
+ tree size = gfc_conv_descriptor_size (rhs_desc, rhs_rank);
+ gfc_conv_descriptor_ubound_set (&block, arr, gfc_index_zero_node, size);
+ gfc_conv_descriptor_stride_set (
+ &block, arr, gfc_index_zero_node,
+ gfc_conv_descriptor_stride_get (rhs_desc, gfc_index_zero_node));
+ for (int i = 1; i < lhs_rank; i++)
+ {
+ gfc_conv_descriptor_lbound_set (&block, arr, gfc_rank_cst[i],
+ gfc_index_zero_node);
+ gfc_conv_descriptor_ubound_set (&block, arr, gfc_rank_cst[i],
+ gfc_index_zero_node);
+ gfc_conv_descriptor_stride_set (&block, arr, gfc_rank_cst[i], size);
+ }
+ gfc_add_modify (&block, gfc_conv_descriptor_dtype (arr),
+ gfc_conv_descriptor_dtype (rhs_desc));
+ gfc_add_modify (&block, gfc_conv_descriptor_rank (arr),
+ build_int_cst (signed_char_type_node, lhs_rank));
+ gfc_conv_descriptor_span_set (&block, arr,
+ gfc_conv_descriptor_span_get (arr));
+ gfc_conv_descriptor_offset_set (&block, arr, gfc_index_zero_node);
+ desc = arr;
+}
+
+ gfc_class_array_data_assign (&block, lhs_desc, desc, true);
+}
+
+
/* Obtain offsets for trans-types.cc(gfc_get_array_descr_info). */
diff --git a/gcc/fortran/trans-array.h b/gcc/fortran/trans-array.h
index 691231f66903..124020a53858 100644
--- a/gcc/fortran/trans-array.h
+++ b/gcc/fortran/trans-array.h
@@ -150,6 +150,7 @@ void gfc_set_descriptor_with_shape (stmtblock_t *, tree,
tree,
tree gfc_get_scalar_to_descriptor_type (tree scalar, symbol_attribute attr);
void gfc_set_descriptor_from_scalar (stmtblock_t *, tree, tree,
symbol_attribute, bool, tree);
+void gfc_copy_sequence_descriptor (stmtblock_t &, tree, tree, bool);
/* Get a single array element. */
void gfc_conv_array_ref (gfc_se *, gfc_array_ref *, gfc_expr *, locus *);
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 2ece9d369d80..205c49949626 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -800,70 +800,6 @@ gfc_get_vptr_from_expr (tree expr)
}
-int
-gfc_descriptor_rank (tree descriptor)
-{
- if (TREE_TYPE (descriptor) != NULL_TREE)
-return GFC_TYPE_ARRAY_RANK (TREE_TYPE (descriptor));
-
- tree dim = gfc_get_descriptor_dimension (descriptor);
- tree dim_type = TREE_TYPE (dim);
- gcc_assert (TREE_CODE (dim_type) == ARRAY_TYPE);
- tree idx_type = TYPE_DOMAIN (dim_type);
- gcc_assert (TREE_CODE (idx_type) == INTEGER_TYPE);
- gcc_assert (integer_zerop (TYPE_MIN_VALUE (idx_type)));
- tree idx_max = TYPE_MAX_VALUE (idx_type);
- if (idx_max == NULL_TREE)
-return GFC_MAX_DIMENSIONS;
- wide_int max = wi::to_wide
[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] Utilisation de la méthode de nullification pour nullifier un pointeur
https://gcc.gnu.org/g:b68e4d2ef22d8fe82d628a320c6577d1d0a946dd
commit b68e4d2ef22d8fe82d628a320c6577d1d0a946dd
Author: Mikael Morin
Date: Wed Dec 18 19:04:41 2024 +0100
Utilisation de la méthode de nullification pour nullifier un pointeur
Correction régression modifiable_p
Correction dump
Ajout assertion
Correction assertion même type
Diff:
---
gcc/fortran/trans-array.cc | 96 ++---
gcc/fortran/trans-array.h | 1 +
gcc/fortran/trans-expr.cc | 35 -
gcc/testsuite/gfortran.dg/class_allocate_14.f90 | 2 +-
4 files changed, 106 insertions(+), 28 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index cdbff27d82ca..4c237b561aa6 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -545,9 +545,9 @@ gfc_conv_descriptor_ubound_set (stmtblock_t *block, tree
desc,
static int
-get_type_info (const gfc_typespec &ts)
+get_type_info (const bt &type)
{
- switch (ts.type)
+ switch (type)
{
case BT_INTEGER:
case BT_LOGICAL:
@@ -558,7 +558,7 @@ get_type_info (const gfc_typespec &ts)
case BT_CLASS:
case BT_VOID:
case BT_UNSIGNED:
- return ts.type;
+ return type;
case BT_PROCEDURE:
case BT_ASSUMED:
@@ -613,11 +613,34 @@ get_size_info (gfc_typespec &ts)
}
-class init_info
+class modify_info
{
public:
+ virtual bool is_initialization () const { return false; }
virtual bool initialize_data () const { return false; }
virtual tree get_data_value () const { return NULL_TREE; }
+};
+
+class nullification : public modify_info
+{
+ virtual bool initialize_data () const { return true; }
+ virtual tree get_data_value () const { return null_pointer_node; }
+ /*
+private:
+ gfc_typespec &ts;
+
+public:
+ null_init(gfc_typespec &arg_ts) : ts(arg_ts) { }
+ virtual bool initialize_data () const { return true; }
+ virtual tree get_data_value () const { return null_pointer_node; }
+ virtual gfc_typespec *get_type () const { return &ts; }
+ */
+};
+
+class init_info : public modify_info
+{
+public:
+ virtual bool is_initialization () const { return true; }
virtual gfc_typespec *get_type () const { return nullptr; }
};
@@ -638,13 +661,13 @@ public:
}
};
-class nullification : public init_info
+class null_init : public init_info
{
private:
gfc_typespec &ts;
public:
- nullification(gfc_typespec &arg_ts) : ts(arg_ts) { }
+ null_init(gfc_typespec &arg_ts) : ts(arg_ts) { }
virtual bool initialize_data () const { return true; }
virtual tree get_data_value () const { return null_pointer_node; }
virtual gfc_typespec *get_type () const { return &ts; }
@@ -700,13 +723,12 @@ build_dtype (gfc_typespec &ts, int rank, const
symbol_attribute &,
CONSTRUCTOR_APPEND_ELT (v, rank_field, rank_val);
}
- if (type_info->type != BT_CLASS)
-{
- tree type_info_field = gfc_advance_chain (fields, GFC_DTYPE_TYPE);
- tree type_info_val = build_int_cst (TREE_TYPE (type_info_field),
- get_type_info (*type_info));
- CONSTRUCTOR_APPEND_ELT (v, type_info_field, type_info_val);
-}
+ tree type_info_field = gfc_advance_chain (fields, GFC_DTYPE_TYPE);
+ tree type_info_val = build_int_cst (TREE_TYPE (type_info_field),
+ get_type_info (type_info->type == BT_CLASS
+? BT_DERIVED
+: type_info->type));
+ CONSTRUCTOR_APPEND_ELT (v, type_info_field, type_info_val);
return build_constructor (type, v);
}
@@ -715,8 +737,8 @@ build_dtype (gfc_typespec &ts, int rank, const
symbol_attribute &,
/* Build a null array descriptor constructor. */
vec *
-get_descriptor_init (tree type, gfc_typespec &ts, int rank,
-const symbol_attribute &attr, const init_info &init)
+get_descriptor_init (tree type, gfc_typespec *ts, int rank,
+const symbol_attribute *attr, const modify_info &init)
{
vec *v = nullptr;
@@ -732,11 +754,15 @@ get_descriptor_init (tree type, gfc_typespec &ts, int
rank,
CONSTRUCTOR_APPEND_ELT (v, data_field, data_value);
}
- tree dtype_field = gfc_advance_chain (fields, DTYPE_FIELD);
- tree dtype_value = build_dtype (ts, rank, attr, init);
- CONSTRUCTOR_APPEND_ELT (v, dtype_field, dtype_value);
+ if (init.is_initialization ())
+{
+ tree dtype_field = gfc_advance_chain (fields, DTYPE_FIELD);
+ tree dtype_value = build_dtype (*ts, rank, *attr,
+ static_cast (init));
+ CONSTRUCTOR_APPEND_ELT (v, dtype_field, dtype_value);
+}
- if (flag_coarray == GFC_FCOARRAY_LIB && attr.codimension)
+ if (flag_coarray == GFC_FCOARRAY_LIB && attr->codimension)
{
/* Declare the variable static so its array descriptor stays present
[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] Factorisation set_contiguous_array
https://gcc.gnu.org/g:b5834effc49cacae162a35ff2deafe3a9bbc9d1c commit b5834effc49cacae162a35ff2deafe3a9bbc9d1c Author: Mikael Morin Date: Fri Jan 17 17:48:42 2025 +0100 Factorisation set_contiguous_array Diff: --- gcc/fortran/trans-array.cc | 13 + 1 file changed, 1 insertion(+), 12 deletions(-) diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc index 76668d8a3ef1..88a2509a5246 100644 --- a/gcc/fortran/trans-array.cc +++ b/gcc/fortran/trans-array.cc @@ -11148,21 +11148,10 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl, tree dest, cdesc = gfc_create_var (cdesc, "cdesc"); DECL_ARTIFICIAL (cdesc) = 1; - gfc_add_modify (&dealloc_block, gfc_conv_descriptor_dtype (cdesc), - gfc_get_dtype_rank_type (1, tmp)); - gfc_conv_descriptor_lbound_set (&dealloc_block, cdesc, - gfc_index_zero_node, - gfc_index_one_node); - gfc_conv_descriptor_stride_set (&dealloc_block, cdesc, - gfc_index_zero_node, - gfc_index_one_node); - gfc_conv_descriptor_ubound_set (&dealloc_block, cdesc, - gfc_index_zero_node, ubound); - if (attr->dimension) comp = gfc_conv_descriptor_data_get (comp); - gfc_conv_descriptor_data_set (&dealloc_block, cdesc, comp); + set_contiguous_array (&dealloc_block, cdesc, ubound, comp); /* Now call the deallocator. */ vtab = gfc_find_vtab (&c->ts);
[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] Factorisation initialisation depuis cfi
https://gcc.gnu.org/g:1392f13442685eacd23ee09a10daccbaf00481ec
commit 1392f13442685eacd23ee09a10daccbaf00481ec
Author: Mikael Morin
Date: Fri Jan 24 16:01:58 2025 +0100
Factorisation initialisation depuis cfi
Correction régression contiguous-2.f90
Correction regression contiguous-2.f90
Correction régression bind-c-contiguous-1.f90
Diff:
---
gcc/fortran/trans-decl.cc | 220 --
gcc/fortran/trans-expr.cc | 209 ---
gcc/fortran/trans.h | 2 +
3 files changed, 194 insertions(+), 237 deletions(-)
diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc
index dad15858fa6a..baa36e88bf15 100644
--- a/gcc/fortran/trans-decl.cc
+++ b/gcc/fortran/trans-decl.cc
@@ -7009,7 +7009,7 @@ gfc_conv_cfi_to_gfc (stmtblock_t *init, stmtblock_t
*finally,
stmtblock_t block;
gfc_init_block (&block);
tree cfi = build_fold_indirect_ref_loc (input_location, cfi_desc);
- tree idx, etype, tmp, tmp2, size_var = NULL_TREE, rank = NULL_TREE;
+ tree idx, tmp, tmp2, size_var = NULL_TREE, rank = NULL_TREE;
bool do_copy_inout = false;
/* When allocatable + intent out, free the cfi descriptor. */
@@ -7201,106 +7201,10 @@ gfc_conv_cfi_to_gfc (stmtblock_t *init, stmtblock_t
*finally,
goto done;
}
- if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (gfc_desc)))
-{
- /* gfc->dtype = ... (from declaration, not from cfi). */
- etype = gfc_get_element_type (TREE_TYPE (gfc_desc));
- gfc_add_modify (&block, gfc_conv_descriptor_dtype (gfc_desc),
- gfc_get_dtype_rank_type (sym->as->rank, etype));
- /* gfc->data = cfi->base_addr. */
- gfc_conv_descriptor_data_set (&block, gfc_desc,
- gfc_get_cfi_desc_base_addr (cfi));
-}
-
- if (sym->ts.type == BT_ASSUMED)
-{
- /* For type(*), take elem_len + dtype.type from the actual argument. */
- gfc_add_modify (&block, gfc_conv_descriptor_elem_len (gfc_desc),
- gfc_get_cfi_desc_elem_len (cfi));
- tree cond;
- tree ctype = gfc_get_cfi_desc_type (cfi);
- ctype = fold_build2_loc (input_location, BIT_AND_EXPR, TREE_TYPE (ctype),
- ctype, build_int_cst (TREE_TYPE (ctype),
-CFI_type_mask));
- tree type = gfc_conv_descriptor_type (gfc_desc);
-
- /* if (CFI_type_cptr) BT_VOID else BT_UNKNOWN */
- /* Note: BT_VOID is could also be CFI_type_funcptr, but assume c_ptr. */
- cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node,
ctype,
- build_int_cst (TREE_TYPE (ctype), CFI_type_cptr));
- tmp = fold_build2_loc (input_location, MODIFY_EXPR, void_type_node, type,
-build_int_cst (TREE_TYPE (type), BT_VOID));
- tmp2 = fold_build2_loc (input_location, MODIFY_EXPR, void_type_node,
- type,
- build_int_cst (TREE_TYPE (type), BT_UNKNOWN));
- tmp2 = fold_build3_loc (input_location, COND_EXPR, void_type_node, cond,
- tmp, tmp2);
- /* if (CFI_type_struct) BT_DERIVED else < tmp2 > */
- cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node,
ctype,
- build_int_cst (TREE_TYPE (ctype),
-CFI_type_struct));
- tmp = fold_build2_loc (input_location, MODIFY_EXPR, void_type_node, type,
-build_int_cst (TREE_TYPE (type), BT_DERIVED));
- tmp2 = fold_build3_loc (input_location, COND_EXPR, void_type_node, cond,
- tmp, tmp2);
- /* if (CFI_type_Character) BT_CHARACTER else < tmp2 > */
- /* Note: this is kind=1, CFI_type_ucs4_char is handled in the 'else if'
-before (see below, as generated bottom up). */
- cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node,
ctype,
- build_int_cst (TREE_TYPE (ctype),
- CFI_type_Character));
- tmp = fold_build2_loc (input_location, MODIFY_EXPR, void_type_node, type,
-build_int_cst (TREE_TYPE (type), BT_CHARACTER));
- tmp2 = fold_build3_loc (input_location, COND_EXPR, void_type_node, cond,
- tmp, tmp2);
- /* if (CFI_type_ucs4_char) BT_CHARACTER else < tmp2 > */
- /* Note: gfc->elem_len = cfi->elem_len/4. */
- /* However, assuming that CFI_type_ucs4_char cannot be recovered, leave
-gfc->elem_len == cfi->elem_len, which helps with operations which use
-sizeof() in Fortran and cfi->elem_len in C. */
- tmp = gfc_get_cfi_desc_type (cfi);
- cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, tmp,
- build_int_cst (TREE_TYPE (tmp),
-
[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] Introduction gfc_copy_sequence_descriptor
https://gcc.gnu.org/g:6d1a550acfb35381deea5afbd424a7e79852f5b1
commit 6d1a550acfb35381deea5afbd424a7e79852f5b1
Author: Mikael Morin
Date: Tue Dec 31 15:27:35 2024 +0100
Introduction gfc_copy_sequence_descriptor
Correction régression sizeof_6
Diff:
---
gcc/fortran/trans-array.cc | 39 ++-
gcc/fortran/trans-expr.cc | 44
gcc/fortran/trans.h| 1 +
3 files changed, 59 insertions(+), 25 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 4c237b561aa6..5d56a12ebf71 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -9901,32 +9901,21 @@ gfc_conv_array_parameter (gfc_se *se, gfc_expr *expr,
bool g77,
if (maybe_shift && !keep_descriptor_lower_bound (expr))
conv_shift_descriptor (&block, se->expr, expr->rank);
+ bool assumed_rank_fsym;
+ if (fsym
+ && ((fsym->ts.type == BT_CLASS
+ && CLASS_DATA (fsym)->as
+ && CLASS_DATA (fsym)->as->type == AS_ASSUMED_RANK)
+ || (fsym->ts.type != BT_CLASS
+ && fsym->as
+ && fsym->as->type == AS_ASSUMED_RANK)))
+ assumed_rank_fsym = true;
+ else
+ assumed_rank_fsym = false;
+
tmp = gfc_class_data_get (ctree);
- if (expr->rank > 1 && CLASS_DATA (fsym)->as->rank != expr->rank
- && CLASS_DATA (fsym)->as->type == AS_EXPLICIT && !no_pack)
- {
- tree arr = gfc_create_var (TREE_TYPE (tmp), "parm");
- gfc_conv_descriptor_data_set (&block, arr,
- gfc_conv_descriptor_data_get (
- se->expr));
- gfc_conv_descriptor_lbound_set (&block, arr, gfc_index_zero_node,
- gfc_index_zero_node);
- gfc_conv_descriptor_ubound_set (
- &block, arr, gfc_index_zero_node,
- gfc_conv_descriptor_size (se->expr, expr->rank));
- gfc_conv_descriptor_stride_set (
- &block, arr, gfc_index_zero_node,
- gfc_conv_descriptor_stride_get (se->expr, gfc_index_zero_node));
- gfc_add_modify (&block, gfc_conv_descriptor_dtype (arr),
- gfc_conv_descriptor_dtype (se->expr));
- gfc_add_modify (&block, gfc_conv_descriptor_rank (arr),
- build_int_cst (signed_char_type_node, 1));
- gfc_conv_descriptor_span_set (&block, arr,
- gfc_conv_descriptor_span_get (arr));
- gfc_conv_descriptor_offset_set (&block, arr, gfc_index_zero_node);
- se->expr = arr;
- }
- gfc_class_array_data_assign (&block, tmp, se->expr, true);
+ gfc_copy_sequence_descriptor (block, tmp, se->expr,
+ assumed_rank_fsym);
/* Handle optional. */
if (fsym && fsym->attr.optional && sym && sym->attr.optional)
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 003754cdad6f..5dff9692f0ba 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -846,6 +846,50 @@ descriptor_rank (tree descriptor)
}
+void
+gfc_copy_sequence_descriptor (stmtblock_t &block, tree lhs_desc, tree rhs_desc,
+ bool assumed_rank_lhs)
+{
+ int lhs_rank = descriptor_rank (lhs_desc);
+ int rhs_rank = descriptor_rank (rhs_desc);
+ tree desc;
+
+ if (assumed_rank_lhs || lhs_rank == rhs_rank)
+desc = rhs_desc;
+ else
+{
+ tree arr = gfc_create_var (TREE_TYPE (lhs_desc), "parm");
+ gfc_conv_descriptor_data_set (&block, arr,
+ gfc_conv_descriptor_data_get (rhs_desc));
+ gfc_conv_descriptor_lbound_set (&block, arr, gfc_index_zero_node,
+ gfc_index_zero_node);
+ tree size = gfc_conv_descriptor_size (rhs_desc, rhs_rank);
+ gfc_conv_descriptor_ubound_set (&block, arr, gfc_index_zero_node, size);
+ gfc_conv_descriptor_stride_set (
+ &block, arr, gfc_index_zero_node,
+ gfc_conv_descriptor_stride_get (rhs_desc, gfc_index_zero_node));
+ for (int i = 1; i < lhs_rank; i++)
+ {
+ gfc_conv_descriptor_lbound_set (&block, arr, gfc_rank_cst[i],
+ gfc_index_zero_node);
+ gfc_conv_descriptor_ubound_set (&block, arr, gfc_rank_cst[i],
+ gfc_index_zero_node);
+ gfc_conv_descriptor_stride_set (&block, arr, gfc_rank_cst[i], size);
+ }
+ gfc_add_modify (&block, gfc_conv_descriptor_dtype (arr),
+ gfc_conv_descriptor_dtype (rhs_desc));
+ gfc_add_modify (&block, gfc_conv_descriptor_rank (arr),
+ build_int_cst (signed_cha
[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] Update dump match count
https://gcc.gnu.org/g:08384499e15f84f573c888267a125e6ae15cd904
commit 08384499e15f84f573c888267a125e6ae15cd904
Author: Mikael Morin
Date: Thu Jan 30 16:53:48 2025 +0100
Update dump match count
Diff:
---
gcc/testsuite/gfortran.dg/coarray_collectives_18.f90 | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/gcc/testsuite/gfortran.dg/coarray_collectives_18.f90
b/gcc/testsuite/gfortran.dg/coarray_collectives_18.f90
index c83899de0e5b..a1f2a76ff73e 100644
--- a/gcc/testsuite/gfortran.dg/coarray_collectives_18.f90
+++ b/gcc/testsuite/gfortran.dg/coarray_collectives_18.f90
@@ -33,5 +33,5 @@ end program
! This lead to access to non exsitant memory in opencoarrays.
! In single image mode just checking for reduced number of
! descriptors is possible, i.e., execute always works.
-! { dg-final { scan-tree-dump-times "desc\\.\[0-9\]+" 12 "original" } }
+! { dg-final { scan-tree-dump-times "desc\\.\[0-9\]+" 10 "original" } }
[gcc r15-7386] LoongArch: Fix ICE caused by illegal calls to builtin functions [PR118561].
https://gcc.gnu.org/g:50d2bde68a097c2e9fb3bdd7e6664c899828
commit r15-7386-g50d2bde68a097c2e9fb3bdd7e6664c899828
Author: Lulu Cheng
Date: Wed Jan 22 17:57:21 2025 +0800
LoongArch: Fix ICE caused by illegal calls to builtin functions [PR118561].
PR target/118561
gcc/ChangeLog:
* config/loongarch/loongarch-builtins.cc
(loongarch_expand_builtin_lsx_test_branch):
NULL_RTX will not be returned when an error is detected.
(loongarch_expand_builtin): Likewise.
gcc/testsuite/ChangeLog:
* gcc.target/loongarch/pr118561.c: New test.
Diff:
---
gcc/config/loongarch/loongarch-builtins.cc| 7 +--
gcc/testsuite/gcc.target/loongarch/pr118561.c | 9 +
2 files changed, 14 insertions(+), 2 deletions(-)
diff --git a/gcc/config/loongarch/loongarch-builtins.cc
b/gcc/config/loongarch/loongarch-builtins.cc
index 92d995a916a9..1849b35357cb 100644
--- a/gcc/config/loongarch/loongarch-builtins.cc
+++ b/gcc/config/loongarch/loongarch-builtins.cc
@@ -2996,7 +2996,10 @@ loongarch_expand_builtin_lsx_test_branch (enum insn_code
icode, tree exp)
ops[1].value = force_reg (ops[1].mode, ops[1].value);
if ((cbranch = maybe_gen_insn (icode, 3, ops)) == NULL_RTX)
-error ("failed to expand built-in function");
+{
+ error ("failed to expand built-in function");
+ return const0_rtx;
+}
cmp_result = gen_reg_rtx (SImode);
@@ -3036,7 +3039,7 @@ loongarch_expand_builtin (tree exp, rtx target, rtx
subtarget ATTRIBUTE_UNUSED,
{
error_at (EXPR_LOCATION (exp),
"built-in function %qD is not enabled", fndecl);
- return target;
+ return target ? target : const0_rtx;
}
switch (d->builtin_type)
diff --git a/gcc/testsuite/gcc.target/loongarch/pr118561.c
b/gcc/testsuite/gcc.target/loongarch/pr118561.c
new file mode 100644
index ..81a776eada39
--- /dev/null
+++ b/gcc/testsuite/gcc.target/loongarch/pr118561.c
@@ -0,0 +1,9 @@
+/* PR target/118561: ICE with -mfpu=none */
+/* { dg-do compile } */
+/* { dg-options "-O2 -march=loongarch64 -mfpu=none" } */
+
+int
+test (void)
+{
+ return __builtin_loongarch_movfcsr2gr (0); /* { dg-error "built-in function
'__builtin_loongarch_movfcsr2gr' is not enabled" } */
+}
[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] Creation méthode initialisation descripteur
https://gcc.gnu.org/g:3c45ca6ee9cb09354b7ede90cf410c13adeec82c
commit 3c45ca6ee9cb09354b7ede90cf410c13adeec82c
Author: Mikael Morin
Date: Thu Dec 5 20:30:08 2024 +0100
Creation méthode initialisation descripteur
Utilisation méthode initialisation descripteur gfc_trans_deferred_array
Correction variable inutilisée
Correction segmentation fault
Correction regression allocatable attribute
Ajout conversion elem_len
conversion type longueur chaine
Initialisation descripteur champ par champ
Silence uninitialized warning.
Diff:
---
gcc/fortran/expr.cc| 25 +++-
gcc/fortran/gfortran.h | 1 +
gcc/fortran/primary.cc | 84 +++-
gcc/fortran/trans-array.cc | 286 +
gcc/fortran/trans-intrinsic.cc | 2 +-
5 files changed, 333 insertions(+), 65 deletions(-)
diff --git a/gcc/fortran/expr.cc b/gcc/fortran/expr.cc
index 7f3f6c52fb54..e4829448f710 100644
--- a/gcc/fortran/expr.cc
+++ b/gcc/fortran/expr.cc
@@ -5411,27 +5411,38 @@ gfc_get_full_arrayspec_from_expr (gfc_expr *expr)
gfc_ref *ref;
if (expr->rank == 0)
-return NULL;
+return nullptr;
/* Follow any component references. */
if (expr->expr_type == EXPR_VARIABLE
|| expr->expr_type == EXPR_CONSTANT)
{
- if (expr->symtree)
- as = expr->symtree->n.sym->as;
+ gfc_symbol *sym = expr->symtree ? expr->symtree->n.sym : nullptr;
+ if (sym
+ && sym->ts.type == BT_CLASS)
+ as = CLASS_DATA (sym)->as;
+ else if (sym)
+ as = sym->as;
else
- as = NULL;
+ as = nullptr;
for (ref = expr->ref; ref; ref = ref->next)
{
switch (ref->type)
{
case REF_COMPONENT:
- as = ref->u.c.component->as;
+ {
+ gfc_component *comp = ref->u.c.component;
+ if (comp->ts.type == BT_CLASS)
+ as = CLASS_DATA (comp)->as;
+ else
+ as = comp->as;
+ }
continue;
case REF_SUBSTRING:
case REF_INQUIRY:
+ as = nullptr;
continue;
case REF_ARRAY:
@@ -5441,7 +5452,7 @@ gfc_get_full_arrayspec_from_expr (gfc_expr *expr)
case AR_ELEMENT:
case AR_SECTION:
case AR_UNKNOWN:
- as = NULL;
+ as = nullptr;
continue;
case AR_FULL:
@@ -5453,7 +5464,7 @@ gfc_get_full_arrayspec_from_expr (gfc_expr *expr)
}
}
else
-as = NULL;
+as = nullptr;
return as;
}
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 7367db8853c6..b14857132ed7 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -4049,6 +4049,7 @@ const char *gfc_dt_lower_string (const char *);
const char *gfc_dt_upper_string (const char *);
/* primary.cc */
+symbol_attribute gfc_symbol_attr (gfc_symbol *);
symbol_attribute gfc_variable_attr (gfc_expr *, gfc_typespec *);
symbol_attribute gfc_expr_attr (gfc_expr *);
symbol_attribute gfc_caf_attr (gfc_expr *, bool i = false, bool *r = NULL);
diff --git a/gcc/fortran/primary.cc b/gcc/fortran/primary.cc
index 8a38720422ec..c934841f4795 100644
--- a/gcc/fortran/primary.cc
+++ b/gcc/fortran/primary.cc
@@ -2867,42 +2867,14 @@ check_substring:
}
-/* Given an expression that is a variable, figure out what the
- ultimate variable's type and attribute is, traversing the reference
- structures if necessary.
-
- This subroutine is trickier than it looks. We start at the base
- symbol and store the attribute. Component references load a
- completely new attribute.
-
- A couple of rules come into play. Subobjects of targets are always
- targets themselves. If we see a component that goes through a
- pointer, then the expression must also be a target, since the
- pointer is associated with something (if it isn't core will soon be
- dumped). If we see a full part or section of an array, the
- expression is also an array.
-
- We can have at most one full array reference. */
-
symbol_attribute
-gfc_variable_attr (gfc_expr *expr, gfc_typespec *ts)
+gfc_symbol_attr (gfc_symbol *sym)
{
- int dimension, codimension, pointer, allocatable, target, optional;
+ int dimension, codimension, pointer, allocatable, target;
symbol_attribute attr;
- gfc_ref *ref;
- gfc_symbol *sym;
- gfc_component *comp;
- bool has_inquiry_part;
-
- if (expr->expr_type != EXPR_VARIABLE
- && expr->expr_type != EXPR_FUNCTION
- && !(expr->expr_type == EXPR_NULL && expr->ts.type != BT_UNKNOWN))
-gfc_internal_error ("gfc_variable_attr(): Expression isn't a variable");
- sym = expr->symtree->n.sym;
attr = sym->attr;
- optional = attr.optional;
if (sym->ts.type == BT_CLASS && sym->attr.class_ok && sym->ts.u.derived)
{
[gcc] Deleted branch 'mikael/heads/refactor_descriptor_v01' in namespace 'refs/users'
The branch 'mikael/heads/refactor_descriptor_v01' in namespace 'refs/users' was deleted. It previously pointed to: b626ff646018... Renseignement token par gfc_set_descriptor_from_scalar. Diff: !!! WARNING: THE FOLLOWING COMMITS ARE NO LONGER ACCESSIBLE (LOST): --- b626ff6... Renseignement token par gfc_set_descriptor_from_scalar. 543f636... Séparation motifs dump assumed_rank_12.f90 d3da1c5... Annulation modif dump assumed_rank_12.f90 ca157c8... Correction régression dummy_3.f90 5373fc6... Correction régression pr86470.f90 0d6f58c... Correction coarray_allocate_8.f08 41b07d9... Correction régression assumed_rank_21.f90 488b4bb... Correction allocate_with_source_16.f90 6ba496d... Correction régression allocate_with_mold_3 25d531c... Nettoyage correction a4bd082... Correction régression allocate_with_source_15.f03 98b94a1... Sauvegarde factorisation set_descriptor_from_scalar 8b3a3bd... Correction compil' 50f79b9... Déplacement gfc_set_gfc_from_cfi 05518ef... Correction erreur compil' b829f1b... Déplacement gfc_copy_sequence_descriptor 327ca6d... Correction erreur compil' 3918d57... Déplacement méthode set_descriptor_from_scalar 0aef327... Suppression code redondant 0838449... Update dump match count 01b40a5... Factorisation set_descriptor_from_scalar dans gfc_conv_scal c3d8cf0... Factorisation set_descriptor_from_scalar conv_derived_to_cl 60fb6b7... Factorisation set_descriptor_from_scalar dans conv_class_to 1392f13... Factorisation initialisation depuis cfi 84be5a4... utilisation booléen allocatable 57a9d25... Factorisation initialisation gfc depuis cfi 7d9a5b7... Refactoring gfc_conv_descriptor_sm_get. 55a2a10... Introduction gfc_conv_descriptor_extent_get c2ce739... Factorisation shift descriptor 41e3834... Factorisation initialisation subarray_descriptor c3a50c1... Factorisation set descriptor with shape b5834ef... Factorisation set_contiguous_array ccb2dcc... Factorisation set_contiguous_array bd3573d... Essai suppression unlimited_polymorphic a6d12d1... Refactor conv_shift_descriptor 7818e31... Factorisation shift descriptor 7421792... Factorisation shift descriptor d607595... Factorisation gfc_conv_expr_descriptor 82413c9... Factorisation copie gfc_conv_expr_descriptor ed6fee2... Extraction fonction fcncall_realloc_result 7ed0026... Factorisation gfc_conv_remap_descriptor 6d1a550... Introduction gfc_copy_sequence_descriptor b68e4d2... Utilisation de la méthode de nullification pour nullifier ecdc8da... Appel méthode shift descriptor dans gfc_trans_pointer_assi 063c001... Déplacement shift descriptor vers gfc_conv_array_parameter db8ddde... Utilisation gfc_clear_descriptor dans gfc_conv_derived_to_c e3de444... Sauvegarde modifs 3c45ca6... Creation méthode initialisation descripteur
[gcc r14-11275] LoongArch: Fix ICE caused by illegal calls to builtin functions [PR118561].
https://gcc.gnu.org/g:9a09fc9b8495f6cfa7b848b0064a96112dcb4a7f
commit r14-11275-g9a09fc9b8495f6cfa7b848b0064a96112dcb4a7f
Author: Lulu Cheng
Date: Wed Jan 22 17:57:21 2025 +0800
LoongArch: Fix ICE caused by illegal calls to builtin functions [PR118561].
PR target/118561
gcc/ChangeLog:
* config/loongarch/loongarch-builtins.cc
(loongarch_expand_builtin_lsx_test_branch):
NULL_RTX will not be returned when an error is detected.
(loongarch_expand_builtin): Likewise.
gcc/testsuite/ChangeLog:
* gcc.target/loongarch/pr118561.c: New test.
(cherry picked from commit 50d2bde68a097c2e9fb3bdd7e6664c899828)
Diff:
---
gcc/config/loongarch/loongarch-builtins.cc| 7 +--
gcc/testsuite/gcc.target/loongarch/pr118561.c | 9 +
2 files changed, 14 insertions(+), 2 deletions(-)
diff --git a/gcc/config/loongarch/loongarch-builtins.cc
b/gcc/config/loongarch/loongarch-builtins.cc
index 8a635938deed..669313ac9b7a 100644
--- a/gcc/config/loongarch/loongarch-builtins.cc
+++ b/gcc/config/loongarch/loongarch-builtins.cc
@@ -3074,7 +3074,10 @@ loongarch_expand_builtin_lsx_test_branch (enum insn_code
icode, tree exp)
ops[1].value = force_reg (ops[1].mode, ops[1].value);
if ((cbranch = maybe_gen_insn (icode, 3, ops)) == NULL_RTX)
-error ("failed to expand built-in function");
+{
+ error ("failed to expand built-in function");
+ return const0_rtx;
+}
cmp_result = gen_reg_rtx (SImode);
@@ -3114,7 +3117,7 @@ loongarch_expand_builtin (tree exp, rtx target, rtx
subtarget ATTRIBUTE_UNUSED,
{
error_at (EXPR_LOCATION (exp),
"built-in function %qD is not enabled", fndecl);
- return target;
+ return target ? target : const0_rtx;
}
switch (d->builtin_type)
diff --git a/gcc/testsuite/gcc.target/loongarch/pr118561.c
b/gcc/testsuite/gcc.target/loongarch/pr118561.c
new file mode 100644
index ..81a776eada39
--- /dev/null
+++ b/gcc/testsuite/gcc.target/loongarch/pr118561.c
@@ -0,0 +1,9 @@
+/* PR target/118561: ICE with -mfpu=none */
+/* { dg-do compile } */
+/* { dg-options "-O2 -march=loongarch64 -mfpu=none" } */
+
+int
+test (void)
+{
+ return __builtin_loongarch_movfcsr2gr (0); /* { dg-error "built-in function
'__builtin_loongarch_movfcsr2gr' is not enabled" } */
+}
[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] Sauvegarde modifs
https://gcc.gnu.org/g:e3de44455296f04e014dad8c9efaef858384cfac
commit e3de44455296f04e014dad8c9efaef858384cfac
Author: Mikael Morin
Date: Sat Dec 7 22:22:10 2024 +0100
Sauvegarde modifs
Annulation suppression else
Correction assertions
Initialisation vptr
Non initialisation elem_len pour les conteneurs de classe
Mise à jour class_allocatable_14
Diff:
---
gcc/fortran/trans-array.cc | 52 ++
gcc/fortran/trans-array.h | 2 +
gcc/fortran/trans-decl.cc | 58 +
gcc/testsuite/gfortran.dg/class_allocate_14.f90 | 2 +-
4 files changed, 66 insertions(+), 48 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 268de211cd66..d15576adde10 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -734,6 +734,58 @@ gfc_build_null_descriptor (tree type, gfc_typespec &ts,
}
+tree
+gfc_build_default_class_descriptor (tree type, gfc_typespec &ts)
+{
+ vec *v = nullptr;
+
+ tree fields = TYPE_FIELDS (type);
+
+#define CLASS_DATA_FIELD 0
+#define CLASS_VPTR_FIELD 1
+
+ tree data_field = gfc_advance_chain (fields, CLASS_DATA_FIELD);
+ tree data_type = TREE_TYPE (data_field);
+
+ gcc_assert (ts.type == BT_CLASS);
+ tree data_value;
+ if (ts.u.derived->components->attr.dimension
+ || (ts.u.derived->components->attr.codimension
+ && flag_coarray != GFC_FCOARRAY_LIB))
+{
+ gcc_assert (GFC_DESCRIPTOR_TYPE_P (data_type));
+ data_value = gfc_build_null_descriptor (data_type,
+ ts,
+
ts.u.derived->components->as->rank,
+ ts.u.derived->components->attr);
+}
+ else
+{
+ gcc_assert (POINTER_TYPE_P (data_type));
+ data_value = fold_convert (data_type, null_pointer_node);
+}
+ CONSTRUCTOR_APPEND_ELT (v, data_field, data_value);
+
+ tree vptr_field = gfc_advance_chain (fields, CLASS_VPTR_FIELD);
+
+ tree vptr_value;
+ if (ts.u.derived->attr.unlimited_polymorphic)
+vptr_value = fold_convert (TREE_TYPE (vptr_field), null_pointer_node);
+ else
+{
+ gfc_symbol *vsym = gfc_find_derived_vtab (ts.u.derived);
+ tree vsym_decl = gfc_get_symbol_decl (vsym);
+ vptr_value = gfc_build_addr_expr (nullptr, vsym_decl);
+}
+ CONSTRUCTOR_APPEND_ELT (v, vptr_field, vptr_value);
+
+#undef CLASS_DATA_FIELD
+#undef CLASS_VPTR_FIELD
+
+ return build_constructor (type, v);
+}
+
+
void
gfc_clear_descriptor (gfc_expr *var_ref, gfc_se &var)
{
diff --git a/gcc/fortran/trans-array.h b/gcc/fortran/trans-array.h
index 1bb3294b0749..63a77d562a7b 100644
--- a/gcc/fortran/trans-array.h
+++ b/gcc/fortran/trans-array.h
@@ -140,6 +140,8 @@ void gfc_set_delta (gfc_loopinfo *);
void gfc_conv_resolve_dependencies (gfc_loopinfo *, gfc_ss *, gfc_ss *);
/* Build a null array descriptor constructor. */
tree gfc_build_null_descriptor (tree);
+tree gfc_build_default_class_descriptor (tree, gfc_typespec &);
+void gfc_clear_descriptor (stmtblock_t *block, gfc_symbol *sym, tree
descriptor);
/* Get a single array element. */
void gfc_conv_array_ref (gfc_se *, gfc_array_ref *, gfc_expr *, locus *);
diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc
index 4ae22a5584d0..dad15858fa6a 100644
--- a/gcc/fortran/trans-decl.cc
+++ b/gcc/fortran/trans-decl.cc
@@ -4780,16 +4780,14 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym,
gfc_wrapped_block * block)
else if (proc_sym == proc_sym->result && IS_CLASS_ARRAY (proc_sym))
{
/* Nullify explicit return class arrays on entry. */
- tree type;
tmp = get_proc_result (proc_sym);
- if (tmp && GFC_CLASS_TYPE_P (TREE_TYPE (tmp)))
- {
- gfc_start_block (&init);
- tmp = gfc_class_data_get (tmp);
- type = TREE_TYPE (gfc_conv_descriptor_data_get (tmp));
- gfc_conv_descriptor_data_set (&init, tmp, build_int_cst (type, 0));
- gfc_add_init_cleanup (block, gfc_finish_block (&init), NULL_TREE);
- }
+ if (tmp && GFC_CLASS_TYPE_P (TREE_TYPE (tmp)))
+ {
+ gfc_start_block (&init);
+ tmp = gfc_class_data_get (tmp);
+ gfc_clear_descriptor (&init, proc_sym, tmp);
+ gfc_add_init_cleanup (block, gfc_finish_block (&init), NULL_TREE);
+ }
}
@@ -4931,48 +4929,13 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym,
gfc_wrapped_block * block)
}
}
- if (sym->attr.pointer && sym->attr.dimension
- && sym->attr.save == SAVE_NONE
- && !sym->attr.use_assoc
- && !sym->attr.host_assoc
- && !sym->attr.dummy
- && GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (sym->backend_decl)))
- {
- gfc_init_block (&tmpblock);
- gfc_conv_descriptor_span_set (&tmpblock, sym->backend_decl,
-
[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] Utilisation gfc_clear_descriptor dans gfc_conv_derived_to_class
https://gcc.gnu.org/g:db8dddefb7b3659f1307058b98421fc9edf2e6de
commit db8dddefb7b3659f1307058b98421fc9edf2e6de
Author: Mikael Morin
Date: Wed Dec 11 16:03:10 2024 +0100
Utilisation gfc_clear_descriptor dans gfc_conv_derived_to_class
essai suppression
Suppression fonction inutilisée
Sauvegarde compilation OK
Correction régression
Sauvegarde correction null_actual_6
Commentage fonction inutilisée
Correction bornes descripteur null
Diff:
---
gcc/fortran/trans-array.cc | 339 +++--
gcc/fortran/trans-array.h | 4 +-
gcc/fortran/trans-expr.cc | 87 ++--
3 files changed, 373 insertions(+), 57 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index d15576adde10..0370d10d9ebd 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -592,10 +592,10 @@ get_size_info (gfc_typespec &ts)
if (POINTER_TYPE_P (type))
type = TREE_TYPE (type);
gcc_assert (TREE_CODE (type) == ARRAY_TYPE);
- tree elt_type = TREE_TYPE (type);
+ tree char_type = TREE_TYPE (type);
tree len = ts.u.cl->backend_decl;
return fold_build2_loc (input_location, MULT_EXPR, size_type_node,
- size_in_bytes (elt_type),
+ size_in_bytes (char_type),
fold_convert (size_type_node, len));
}
@@ -613,8 +613,61 @@ get_size_info (gfc_typespec &ts)
}
+class init_info
+{
+public:
+ virtual bool initialize_data () const { return false; }
+ virtual tree get_data_value () const { return NULL_TREE; }
+ virtual gfc_typespec *get_type () const { return nullptr; }
+};
+
+
+class default_init : public init_info
+{
+private:
+ const symbol_attribute &attr;
+
+public:
+ default_init (const symbol_attribute &arg_attr) : attr(arg_attr) { }
+ virtual bool initialize_data () const { return !attr.pointer; }
+ virtual tree get_data_value () const {
+if (!initialize_data ())
+ return NULL_TREE;
+
+return null_pointer_node;
+ }
+};
+
+class nullification : public init_info
+{
+private:
+ gfc_typespec &ts;
+
+public:
+ nullification(gfc_typespec &arg_ts) : ts(arg_ts) { }
+ virtual bool initialize_data () const { return true; }
+ virtual tree get_data_value () const { return null_pointer_node; }
+ virtual gfc_typespec *get_type () const { return &ts; }
+};
+
+class scalar_value : public init_info
+{
+private:
+ gfc_typespec &ts;
+ tree value;
+
+public:
+ scalar_value(gfc_typespec &arg_ts, tree arg_value)
+: ts(arg_ts), value(arg_value) { }
+ virtual bool initialize_data () const { return true; }
+ virtual tree get_data_value () const { return value; }
+ virtual gfc_typespec *get_type () const { return &ts; }
+};
+
+
static tree
-build_dtype (gfc_typespec &ts, int rank, const symbol_attribute &)
+build_dtype (gfc_typespec &ts, int rank, const symbol_attribute &,
+const init_info &init)
{
vec *v = nullptr;
@@ -622,11 +675,17 @@ build_dtype (gfc_typespec &ts, int rank, const
symbol_attribute &)
tree fields = TYPE_FIELDS (type);
- if (ts.type != BT_CLASS)
+ gfc_typespec *type_info = init.get_type ();
+ if (type_info == nullptr)
+type_info = &ts;
+
+ if (!(type_info->type == BT_CLASS
+ || (type_info->type == BT_CHARACTER
+ && type_info->deferred)))
{
tree elem_len_field = gfc_advance_chain (fields, GFC_DTYPE_ELEM_LEN);
tree elem_len_val = fold_convert (TREE_TYPE (elem_len_field),
- get_size_info (ts));
+ get_size_info (*type_info));
CONSTRUCTOR_APPEND_ELT (v, elem_len_field, elem_len_val);
}
@@ -641,11 +700,11 @@ build_dtype (gfc_typespec &ts, int rank, const
symbol_attribute &)
CONSTRUCTOR_APPEND_ELT (v, rank_field, rank_val);
}
- if (ts.type != BT_CLASS)
+ if (type_info->type != BT_CLASS)
{
tree type_info_field = gfc_advance_chain (fields, GFC_DTYPE_TYPE);
tree type_info_val = build_int_cst (TREE_TYPE (type_info_field),
- get_type_info (ts));
+ get_type_info (*type_info));
CONSTRUCTOR_APPEND_ELT (v, type_info_field, type_info_val);
}
@@ -656,8 +715,8 @@ build_dtype (gfc_typespec &ts, int rank, const
symbol_attribute &)
/* Build a null array descriptor constructor. */
vec *
-get_default_descriptor_init (tree type, gfc_typespec &ts, int rank,
-const symbol_attribute &attr)
+get_descriptor_init (tree type, gfc_typespec &ts, int rank,
+const symbol_attribute &attr, const init_info &init)
{
vec *v = nullptr;
@@ -666,15 +725,15 @@ get_default_descriptor_init (tree type, gfc_typespec &ts,
int rank,
tree fields = TYPE_FIELDS (type);
/* Don't init pointers by default. */
- if
[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] Extraction fonction fcncall_realloc_result
https://gcc.gnu.org/g:ed6fee22d9c29ebee21ce323726fb14cfb8d6ed1
commit ed6fee22d9c29ebee21ce323726fb14cfb8d6ed1
Author: Mikael Morin
Date: Thu Jan 9 21:38:39 2025 +0100
Extraction fonction fcncall_realloc_result
Correction variable inutilisée
Correction régression coarray dummy_3
Correction régression dummy_3
Diff:
---
gcc/fortran/trans-array.cc | 64 ++
gcc/fortran/trans-array.h | 1 +
gcc/fortran/trans-expr.cc | 52 +++--
3 files changed, 80 insertions(+), 37 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 898930634ad1..7d43a8c000d3 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -1451,6 +1451,70 @@ gfc_conv_remap_descriptor (stmtblock_t *block, tree
dest, tree src,
}
+class conditional_lb
+{
+ tree cond;
+public:
+ conditional_lb (tree arg_cond)
+: cond (arg_cond) { }
+
+ tree lower_bound (tree src, int n) const {
+tree lbound = gfc_conv_descriptor_lbound_get (src, gfc_rank_cst[n]);
+lbound = fold_build3_loc (input_location, COND_EXPR,
+ gfc_array_index_type, cond,
+ gfc_index_one_node, lbound);
+return lbound;
+ }
+};
+
+
+static void
+gfc_conv_shift_descriptor (stmtblock_t *block, tree dest, tree src,
+ int rank, const conditional_lb &lb)
+{
+ tree tmp = gfc_conv_descriptor_data_get (src);
+ gfc_conv_descriptor_data_set (block, dest, tmp);
+
+ tree offset = gfc_index_zero_node;
+ for (int n = 0 ; n < rank; n++)
+{
+ tree lbound;
+
+ lbound = lb.lower_bound (dest, n);
+ lbound = gfc_evaluate_now (lbound, block);
+
+ tmp = gfc_conv_descriptor_ubound_get (src, gfc_rank_cst[n]);
+ tmp = fold_build2_loc (input_location, PLUS_EXPR,
+gfc_array_index_type, tmp, lbound);
+ gfc_conv_descriptor_lbound_set (block, dest,
+ gfc_rank_cst[n], lbound);
+ gfc_conv_descriptor_ubound_set (block, dest,
+ gfc_rank_cst[n], tmp);
+
+ /* Set stride and accumulate the offset. */
+ tmp = gfc_conv_descriptor_stride_get (src, gfc_rank_cst[n]);
+ gfc_conv_descriptor_stride_set (block, dest,
+ gfc_rank_cst[n], tmp);
+ tmp = fold_build2_loc (input_location, MULT_EXPR,
+gfc_array_index_type, lbound, tmp);
+ offset = fold_build2_loc (input_location, MINUS_EXPR,
+ gfc_array_index_type, offset, tmp);
+ offset = gfc_evaluate_now (offset, block);
+}
+
+ gfc_conv_descriptor_offset_set (block, dest, offset);
+}
+
+
+void
+gfc_conv_shift_descriptor (stmtblock_t *block, tree dest, tree src,
+ int rank, tree zero_cond)
+{
+ gfc_conv_shift_descriptor (block, dest, src, rank,
+conditional_lb (zero_cond));
+}
+
+
static bool
keep_descriptor_lower_bound (gfc_expr *e)
{
diff --git a/gcc/fortran/trans-array.h b/gcc/fortran/trans-array.h
index 8df55c2c00a5..571322ae11ff 100644
--- a/gcc/fortran/trans-array.h
+++ b/gcc/fortran/trans-array.h
@@ -216,6 +216,7 @@ tree gfc_get_cfi_dim_sm (tree, tree);
/* Shift lower bound of descriptor, updating ubound and offset. */
void gfc_conv_shift_descriptor_lbound (stmtblock_t*, tree, int, tree);
void gfc_conv_shift_descriptor (stmtblock_t*, tree, const gfc_array_ref &);
+void gfc_conv_shift_descriptor (stmtblock_t*, tree, tree, int, tree);
/* Add pre-loop scalarization code for intrinsic functions which require
special handling. */
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index c50b1e05cdbd..77e8a55af457 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -832,6 +832,9 @@ gfc_get_vptr_from_expr (tree expr)
int
gfc_descriptor_rank (tree descriptor)
{
+ if (TREE_TYPE (descriptor) != NULL_TREE)
+return GFC_TYPE_ARRAY_RANK (TREE_TYPE (descriptor));
+
tree dim = gfc_get_descriptor_dimension (descriptor);
tree dim_type = TREE_TYPE (dim);
gcc_assert (TREE_CODE (dim_type) == ARRAY_TYPE);
@@ -916,8 +919,17 @@ gfc_class_array_data_assign (stmtblock_t *block, tree
lhs_desc, tree rhs_desc,
type = TREE_TYPE (tmp);
else
{
- gcc_assert (TREE_TYPE (tmp) == TREE_TYPE (tmp2));
- type = TREE_TYPE (tmp);
+ int corank = GFC_TYPE_ARRAY_CORANK (TREE_TYPE (lhs_desc));
+ int corank2 = GFC_TYPE_ARRAY_CORANK (TREE_TYPE (rhs_desc));
+ if (corank > 0 && corank2 == 0)
+ type = TREE_TYPE (tmp2);
+ else if (corank2 > 0 && corank == 0)
+ type = TREE_TYPE (tmp);
+ else
+ {
+ gcc_assert (TREE_TYPE (tmp) == TREE_TYPE (tmp2));
+ type = TREE_TYPE (tmp);
+ }
}
tmp = build4_loc (input_location, ARRAY_RANGE_REF, type, tmp,
@@ -11595,7 +11607,6 @@ fcncall_realloc_result (g
[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] Factorisation gfc_conv_remap_descriptor
https://gcc.gnu.org/g:7ed00263a569c00bf6bf52ea343e677b873e0e2f
commit 7ed00263a569c00bf6bf52ea343e677b873e0e2f
Author: Mikael Morin
Date: Sat Jan 4 21:36:13 2025 +0100
Factorisation gfc_conv_remap_descriptor
Correction régression pointer_remapping_5
Diff:
---
gcc/fortran/trans-array.cc | 119 +++
gcc/fortran/trans-expr.cc | 124 +++--
gcc/fortran/trans.h| 2 +
3 files changed, 129 insertions(+), 116 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 5d56a12ebf71..898930634ad1 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -1332,6 +1332,125 @@ gfc_conv_shift_descriptor (stmtblock_t *block, tree
desc,
}
+void
+gfc_conv_remap_descriptor (stmtblock_t *block, tree dest, tree src,
+ int src_rank, const gfc_array_spec &as)
+{
+ int dest_rank = gfc_descriptor_rank (dest);
+
+ /* Set dtype. */
+ tree dtype = gfc_conv_descriptor_dtype (dest);
+ tree tmp = gfc_get_dtype (TREE_TYPE (src));
+ gfc_add_modify (block, dtype, tmp);
+
+ /* Copy data pointer. */
+ tree data = gfc_conv_descriptor_data_get (src);
+ gfc_conv_descriptor_data_set (block, dest, data);
+
+ /* Copy the span. */
+ tree span;
+ if (VAR_P (src)
+ && GFC_DECL_PTR_ARRAY_P (src))
+span = gfc_conv_descriptor_span_get (src);
+ else
+{
+ tmp = TREE_TYPE (src);
+ tmp = TYPE_SIZE_UNIT (gfc_get_element_type (tmp));
+ span = fold_convert (gfc_array_index_type, tmp);
+}
+ gfc_conv_descriptor_span_set (block, dest, span);
+
+ /* Copy offset but adjust it such that it would correspond
+ to a lbound of zero. */
+ if (src_rank == -1)
+gfc_conv_descriptor_offset_set (block, dest,
+ gfc_index_zero_node);
+ else
+{
+ tree offs = gfc_conv_descriptor_offset_get (src);
+ for (int dim = 0; dim < src_rank; ++dim)
+ {
+ tree stride = gfc_conv_descriptor_stride_get (src,
+ gfc_rank_cst[dim]);
+ tree lbound = gfc_conv_descriptor_lbound_get (src,
+ gfc_rank_cst[dim]);
+ tmp = fold_build2_loc (input_location, MULT_EXPR,
+gfc_array_index_type, stride,
+lbound);
+ offs = fold_build2_loc (input_location, PLUS_EXPR,
+ gfc_array_index_type, offs, tmp);
+ }
+ gfc_conv_descriptor_offset_set (block, dest, offs);
+}
+ /* Set the bounds as declared for the LHS and calculate strides as
+ well as another offset update accordingly. */
+ tree stride = gfc_conv_descriptor_stride_get (src,
+ gfc_rank_cst[0]);
+ for (int dim = 0; dim < dest_rank; ++dim)
+{
+ gfc_se lower_se;
+ gfc_se upper_se;
+
+ gcc_assert (as.lower[dim] && as.upper[dim]);
+
+ /* Convert declared bounds. */
+ gfc_init_se (&lower_se, NULL);
+ gfc_init_se (&upper_se, NULL);
+ gfc_conv_expr (&lower_se, as.lower[dim]);
+ gfc_conv_expr (&upper_se, as.upper[dim]);
+
+ gfc_add_block_to_block (block, &lower_se.pre);
+ gfc_add_block_to_block (block, &upper_se.pre);
+
+ tree lbound = fold_convert (gfc_array_index_type, lower_se.expr);
+ tree ubound = fold_convert (gfc_array_index_type, upper_se.expr);
+
+ lbound = gfc_evaluate_now (lbound, block);
+ ubound = gfc_evaluate_now (ubound, block);
+
+ gfc_add_block_to_block (block, &lower_se.post);
+ gfc_add_block_to_block (block, &upper_se.post);
+
+ /* Set bounds in descriptor. */
+ gfc_conv_descriptor_lbound_set (block, dest,
+ gfc_rank_cst[dim], lbound);
+ gfc_conv_descriptor_ubound_set (block, dest,
+ gfc_rank_cst[dim], ubound);
+
+ /* Set stride. */
+ stride = gfc_evaluate_now (stride, block);
+ gfc_conv_descriptor_stride_set (block, dest,
+ gfc_rank_cst[dim], stride);
+
+ /* Update offset. */
+ tree offs = gfc_conv_descriptor_offset_get (dest);
+ tmp = fold_build2_loc (input_location, MULT_EXPR,
+gfc_array_index_type, lbound, stride);
+ offs = fold_build2_loc (input_location, MINUS_EXPR,
+ gfc_array_index_type, offs, tmp);
+ offs = gfc_evaluate_now (offs, block);
+ gfc_conv_descriptor_offset_set (block, dest, offs);
+
+ /* Update stride. */
+ tmp = gfc_conv_array_extent_dim (lbound, ubound, NULL);
+ stride = fold_build2_loc (input_location, MULT_EXPR,
+ gfc_array_index_type, stride, tmp);
+}
+}
+
+
+void
+gfc_conv_remap_descriptor (stmtblock_t *block, tree dest, tree src,
+ int src_rank, const gfc_array_ref &ar)
+{
+ g
[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] Déplacement shift descriptor vers gfc_conv_array_parameter
https://gcc.gnu.org/g:063c0014407236e53fa5c3734cab2f3fec5fa03f
commit 063c0014407236e53fa5c3734cab2f3fec5fa03f
Author: Mikael Morin
Date: Tue Dec 17 17:27:24 2024 +0100
Déplacement shift descriptor vers gfc_conv_array_parameter
Suppression variables inutilisées
Diff:
---
gcc/fortran/trans-array.cc | 49 ++
gcc/fortran/trans-array.h | 2 +-
gcc/fortran/trans-expr.cc | 20 +--
3 files changed, 43 insertions(+), 28 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 0370d10d9ebd..2fdd15962e49 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -1151,6 +1151,43 @@ gfc_conv_shift_descriptor_lbound (stmtblock_t* block,
tree desc,
}
+static void
+conv_shift_descriptor (stmtblock_t* block, tree desc, int rank)
+{
+ /* Apply a shift of the lbound when supplied. */
+ for (int dim = 0; dim < rank; ++dim)
+gfc_conv_shift_descriptor_lbound (block, desc, dim,
+ gfc_index_one_node);
+}
+
+
+static bool
+keep_descriptor_lower_bound (gfc_expr *e)
+{
+ gfc_ref *ref;
+
+ /* Detect any array references with vector subscripts. */
+ for (ref = e->ref; ref; ref = ref->next)
+if (ref->type == REF_ARRAY && ref->u.ar.type != AR_ELEMENT
+ && ref->u.ar.type != AR_FULL)
+ {
+ int dim;
+ for (dim = 0; dim < ref->u.ar.dimen; dim++)
+ if (ref->u.ar.dimen_type[dim] == DIMEN_VECTOR)
+ break;
+ if (dim < ref->u.ar.dimen)
+ break;
+ }
+
+ /* Array references with vector subscripts and non-variable
+ expressions need be converted to a one-based descriptor. */
+ if (ref || e->expr_type != EXPR_VARIABLE)
+return false;
+
+ return true;
+}
+
+
/* Obtain offsets for trans-types.cc(gfc_get_array_descr_info). */
void
@@ -9454,7 +9491,7 @@ is_pointer (gfc_expr *e)
void
gfc_conv_array_parameter (gfc_se *se, gfc_expr *expr, bool g77,
const gfc_symbol *fsym, const char *proc_name,
- tree *size, tree *lbshift, tree *packed)
+ tree *size, bool maybe_shift, tree *packed)
{
tree ptr;
tree desc;
@@ -9690,13 +9727,9 @@ gfc_conv_array_parameter (gfc_se *se, gfc_expr *expr,
bool g77,
stmtblock_t block;
gfc_init_block (&block);
- if (lbshift && *lbshift)
- {
- /* Apply a shift of the lbound when supplied. */
- for (int dim = 0; dim < expr->rank; ++dim)
- gfc_conv_shift_descriptor_lbound (&block, se->expr, dim,
- *lbshift);
- }
+ if (maybe_shift && !keep_descriptor_lower_bound (expr))
+ conv_shift_descriptor (&block, se->expr, expr->rank);
+
tmp = gfc_class_data_get (ctree);
if (expr->rank > 1 && CLASS_DATA (fsym)->as->rank != expr->rank
&& CLASS_DATA (fsym)->as->type == AS_EXPLICIT && !no_pack)
diff --git a/gcc/fortran/trans-array.h b/gcc/fortran/trans-array.h
index 78646275b4ec..17e3d08fdba0 100644
--- a/gcc/fortran/trans-array.h
+++ b/gcc/fortran/trans-array.h
@@ -158,7 +158,7 @@ tree gfc_get_array_span (tree, gfc_expr *);
void gfc_conv_expr_descriptor (gfc_se *, gfc_expr *);
/* Convert an array for passing as an actual function parameter. */
void gfc_conv_array_parameter (gfc_se *, gfc_expr *, bool, const gfc_symbol *,
- const char *, tree *, tree * = nullptr,
+ const char *, tree *, bool = false,
tree * = nullptr);
/* These work with both descriptors and descriptorless arrays. */
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 6978f83cdc8c..e8b229d853e3 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -991,8 +991,6 @@ gfc_conv_derived_to_class (gfc_se *parmse, gfc_expr *e,
gfc_symbol *fsym,
stmtblock_t block;
gfc_init_block (&block);
gfc_ref *ref;
- int dim;
- tree lbshift = NULL_TREE;
/* Array refs with sections indicate, that a for a formal argument
expecting contiguous repacking needs to be done. */
@@ -1005,25 +1003,9 @@ gfc_conv_derived_to_class (gfc_se *parmse, gfc_expr *e,
gfc_symbol *fsym,
&& (ref || e->rank != fsym->ts.u.derived->components->as->rank))
fsym->attr.contiguous = 1;
- /* Detect any array references with vector subscripts. */
- for (ref = e->ref; ref; ref = ref->next)
- if (ref->type == REF_ARRAY && ref->u.ar.type != AR_ELEMENT
- && ref->u.ar.type != AR_FULL)
- {
- for (dim = 0; dim < ref->u.ar.dimen; dim++)
- if (ref->u.ar.dimen_type[dim] == DIMEN_VECTOR)
- break;
- if (dim < ref->u.ar.dimen)
- break;
- }
-
[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] Appel méthode shift descriptor dans gfc_trans_pointer_assignment
https://gcc.gnu.org/g:ecdc8da68c9d5419d4c0e6ec9b1b3278076cbdf0
commit ecdc8da68c9d5419d4c0e6ec9b1b3278076cbdf0
Author: Mikael Morin
Date: Tue Dec 17 22:37:18 2024 +0100
Appel méthode shift descriptor dans gfc_trans_pointer_assignment
Diff:
---
gcc/fortran/trans-array.cc | 129 +++--
gcc/fortran/trans-array.h | 1 +
gcc/fortran/trans-expr.cc | 28 +-
3 files changed, 129 insertions(+), 29 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 2fdd15962e49..cdbff27d82ca 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -1151,13 +1151,136 @@ gfc_conv_shift_descriptor_lbound (stmtblock_t* block,
tree desc,
}
+class lb_info
+{
+public:
+ virtual gfc_expr *lower_bound (int dim) const = 0;
+};
+
+
+class unset_lb : public lb_info
+{
+public:
+ virtual gfc_expr *lower_bound (int) const { return nullptr; }
+};
+
+
+class defined_lb : public lb_info
+{
+ int rank;
+ gfc_expr * const * lower_bounds;
+
+public:
+ defined_lb (int arg_rank, gfc_expr * const
arg_lower_bounds[GFC_MAX_DIMENSIONS])
+: rank(arg_rank), lower_bounds(arg_lower_bounds) { }
+ virtual gfc_expr *lower_bound (int dim) const { return lower_bounds[dim]; }
+};
+
+
static void
-conv_shift_descriptor (stmtblock_t* block, tree desc, int rank)
+conv_shift_descriptor (stmtblock_t *block, tree desc, int rank,
+ const lb_info &info)
{
/* Apply a shift of the lbound when supplied. */
for (int dim = 0; dim < rank; ++dim)
-gfc_conv_shift_descriptor_lbound (block, desc, dim,
- gfc_index_one_node);
+{
+ gfc_expr *lb_expr = info.lower_bound(dim);
+
+ tree lower_bound;
+ if (lb_expr == nullptr)
+ lower_bound = gfc_index_one_node;
+ else
+ {
+ gfc_se lb_se;
+
+ gfc_init_se (&lb_se, nullptr);
+ gfc_conv_expr (&lb_se, lb_expr);
+
+ gfc_add_block_to_block (block, &lb_se.pre);
+ tree lb_var = gfc_create_var (TREE_TYPE (lb_se.expr), "lower_bound");
+ gfc_add_modify (block, lb_var, lb_se.expr);
+ gfc_add_block_to_block (block, &lb_se.post);
+
+ lower_bound = lb_var;
+ }
+
+ gfc_conv_shift_descriptor_lbound (block, desc, dim, lower_bound);
+}
+}
+
+
+static void
+conv_shift_descriptor (stmtblock_t* block, tree desc, int rank)
+{
+ conv_shift_descriptor (block, desc, rank, unset_lb ());
+}
+
+
+static void
+conv_shift_descriptor (stmtblock_t *block, tree desc, int rank,
+ gfc_expr * const lower_bounds[GFC_MAX_DIMENSIONS])
+{
+ conv_shift_descriptor (block, desc, rank, defined_lb (rank, lower_bounds));
+}
+
+
+static void
+conv_shift_descriptor (stmtblock_t *block, tree desc,
+ const gfc_array_spec &as)
+{
+ conv_shift_descriptor (block, desc, as.rank, as.lower);
+}
+
+
+static void
+set_type (array_type &type, array_type value)
+{
+ gcc_assert (type == AS_UNKNOWN || type == value);
+ type = value;
+}
+
+
+static void
+array_ref_to_array_spec (const gfc_array_ref &ref, gfc_array_spec &spec)
+{
+ spec.rank = ref.dimen;
+ spec.corank = ref.codimen;
+
+ spec.type = AS_UNKNOWN;
+ spec.cotype = AS_ASSUMED_SIZE;
+
+ for (int dim = 0; dim < spec.rank + spec.corank; dim++)
+switch (ref.dimen_type[dim])
+ {
+ case DIMEN_ELEMENT:
+ spec.upper[dim] = ref.start[dim];
+ set_type (spec.type, AS_EXPLICIT);
+ break;
+
+ case DIMEN_RANGE:
+ spec.lower[dim] = ref.start[dim];
+ spec.upper[dim] = ref.end[dim];
+ if (spec.upper[dim] == nullptr)
+ set_type (spec.type, AS_DEFERRED);
+ else
+ set_type (spec.type, AS_EXPLICIT);
+ break;
+
+ default:
+ break;
+ }
+}
+
+
+void
+gfc_conv_shift_descriptor (stmtblock_t *block, tree desc,
+ const gfc_array_ref &ar)
+{
+ gfc_array_spec as;
+
+ array_ref_to_array_spec (ar, as);
+
+ conv_shift_descriptor (block, desc, as);
}
diff --git a/gcc/fortran/trans-array.h b/gcc/fortran/trans-array.h
index 17e3d08fdba0..3b05a2eb197a 100644
--- a/gcc/fortran/trans-array.h
+++ b/gcc/fortran/trans-array.h
@@ -214,6 +214,7 @@ tree gfc_get_cfi_dim_sm (tree, tree);
/* Shift lower bound of descriptor, updating ubound and offset. */
void gfc_conv_shift_descriptor_lbound (stmtblock_t*, tree, int, tree);
+void gfc_conv_shift_descriptor (stmtblock_t*, tree, const gfc_array_ref &);
/* Add pre-loop scalarization code for intrinsic functions which require
special handling. */
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index e8b229d853e3..1de4a73974d6 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -11180,32 +11180,8 @@ gfc_trans_pointer_assignment (gfc_expr * expr1,
gfc_expr * expr2)
}
}
else
- {
- /* Bounds remapping. Just shift the lower bounds. */
-
-
[gcc] Created branch 'mikael/heads/refactor_descriptor_v01' in namespace 'refs/users'
The branch 'mikael/heads/refactor_descriptor_v01' was created in namespace 'refs/users' pointing to: 96c395b57efb... Renseignement token par gfc_set_descriptor_from_scalar.
[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] Factorisation gfc_conv_expr_descriptor
https://gcc.gnu.org/g:d607595f1f4f4566776000aeedfd4d0bb3ce4b9b
commit d607595f1f4f4566776000aeedfd4d0bb3ce4b9b
Author: Mikael Morin
Date: Thu Jan 16 14:00:20 2025 +0100
Factorisation gfc_conv_expr_descriptor
Diff:
---
gcc/fortran/trans-array.cc | 358 +++--
1 file changed, 186 insertions(+), 172 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 097a9a0d860a..ec0badd0dc33 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -1542,6 +1542,25 @@ keep_descriptor_lower_bound (gfc_expr *e)
}
+static void
+copy_descriptor (stmtblock_t *block, tree dest, tree src,
+gfc_expr *src_expr, bool subref)
+{
+ /* Copy the descriptor for pointer assignments. */
+ gfc_add_modify (block, dest, src);
+
+ /* Add any offsets from subreferences. */
+ gfc_get_dataptr_offset (block, dest, src, NULL_TREE, subref, src_expr);
+
+ /* and set the span field. */
+ tree tmp;
+ if (src_expr->ts.type == BT_CHARACTER)
+tmp = gfc_conv_descriptor_span_get (src);
+ else
+tmp = gfc_get_array_span (src, src_expr);
+ gfc_conv_descriptor_span_set (block, dest, tmp);
+}
+
/* Obtain offsets for trans-types.cc(gfc_get_array_descr_info). */
void
@@ -8991,24 +9010,175 @@ is_explicit_coarray (gfc_expr *expr)
static void
-copy_descriptor (stmtblock_t *block, tree dest, tree src,
-gfc_expr *src_expr, bool subref)
+set_descriptor (stmtblock_t *block, tree dest, tree src, gfc_expr *src_expr,
+ int rank, int corank, gfc_ss *ss, gfc_array_info *info,
+ tree lowers[GFC_MAX_DIMENSIONS],
+ tree uppers[GFC_MAX_DIMENSIONS],
+ bool unlimited_polymorphic, bool data_needed, bool subref)
{
- /* Copy the descriptor for pointer assignments. */
- gfc_add_modify (block, dest, src);
+ int ndim = info->ref ? info->ref->u.ar.dimen : rank;
- /* Add any offsets from subreferences. */
- gfc_get_dataptr_offset (block, dest, src, NULL_TREE, subref, src_expr);
-
- /* and set the span field. */
- tree tmp;
- if (src_expr->ts.type == BT_CHARACTER)
+ /* Set the span field. */
+ tree tmp = NULL_TREE;
+ if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (src)))
tmp = gfc_conv_descriptor_span_get (src);
else
tmp = gfc_get_array_span (src, src_expr);
- gfc_conv_descriptor_span_set (block, dest, tmp);
+ if (tmp)
+gfc_conv_descriptor_span_set (block, dest, tmp);
+
+ /* The following can be somewhat confusing. We have two
+ descriptors, a new one and the original array.
+ {dest, parmtype, dim} refer to the new one.
+ {src, type, n, loop} refer to the original, which maybe
+ a descriptorless array.
+ The bounds of the scalarization are the bounds of the section.
+ We don't have to worry about numeric overflows when calculating
+ the offsets because all elements are within the array data. */
+
+ /* Set the dtype. */
+ tmp = gfc_conv_descriptor_dtype (dest);
+ tree dtype;
+ if (unlimited_polymorphic)
+dtype = gfc_get_dtype (TREE_TYPE (src), &rank);
+ else if (src_expr->ts.type == BT_ASSUMED)
+{
+ tree tmp2 = src;
+ if (DECL_LANG_SPECIFIC (tmp2) && GFC_DECL_SAVED_DESCRIPTOR (tmp2))
+ tmp2 = GFC_DECL_SAVED_DESCRIPTOR (tmp2);
+ if (POINTER_TYPE_P (TREE_TYPE (tmp2)))
+ tmp2 = build_fold_indirect_ref_loc (input_location, tmp2);
+ dtype = gfc_conv_descriptor_dtype (tmp2);
+}
+ else
+dtype = gfc_get_dtype (TREE_TYPE (dest));
+ gfc_add_modify (block, tmp, dtype);
+
+ /* The 1st element in the section. */
+ tree base = gfc_index_zero_node;
+ if (src_expr->ts.type == BT_CHARACTER && src_expr->rank == 0 && corank)
+base = gfc_index_one_node;
+
+ /* The offset from the 1st element in the section. */
+ tree offset = gfc_index_zero_node;
+
+ for (int n = 0; n < ndim; n++)
+{
+ tree stride = gfc_conv_array_stride (src, n);
+
+ /* Work out the 1st element in the section. */
+ tree start;
+ if (info->ref
+ && info->ref->u.ar.dimen_type[n] == DIMEN_ELEMENT)
+ {
+ gcc_assert (info->subscript[n]
+ && info->subscript[n]->info->type == GFC_SS_SCALAR);
+ start = info->subscript[n]->info->data.scalar.value;
+ }
+ else
+ {
+ /* Evaluate and remember the start of the section. */
+ start = info->start[n];
+ stride = gfc_evaluate_now (stride, block);
+ }
+
+ tmp = gfc_conv_array_lbound (src, n);
+ tmp = fold_build2_loc (input_location, MINUS_EXPR, TREE_TYPE (tmp),
+start, tmp);
+ tmp = fold_build2_loc (input_location, MULT_EXPR, TREE_TYPE (tmp),
+tmp, stride);
+ base = fold_build2_loc (input_location, PLUS_EXPR, TREE_TYPE (tmp),
+ base, tmp);
+
+ if (info->ref
+ && info->ref->u.ar.dimen_type[n] == DIMEN_ELEMENT)
+ {
+
[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] Factorisation shift descriptor
https://gcc.gnu.org/g:7421792ba1ee3c272b294ac19a85bc43ad73e3c7
commit 7421792ba1ee3c272b294ac19a85bc43ad73e3c7
Author: Mikael Morin
Date: Thu Jan 16 14:35:14 2025 +0100
Factorisation shift descriptor
Diff:
---
gcc/fortran/trans-array.cc | 6 +++---
gcc/fortran/trans-array.h | 1 +
gcc/fortran/trans-stmt.cc | 6 +-
3 files changed, 5 insertions(+), 8 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index ec0badd0dc33..ecdaad3f9575 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -1257,8 +1257,8 @@ conv_shift_descriptor (stmtblock_t *block, tree desc, int
rank,
}
-static void
-conv_shift_descriptor (stmtblock_t* block, tree desc, int rank)
+void
+gfc_conv_shift_descriptor (stmtblock_t* block, tree desc, int rank)
{
conv_shift_descriptor (block, desc, rank, unset_lb ());
}
@@ -10103,7 +10103,7 @@ gfc_conv_array_parameter (gfc_se *se, gfc_expr *expr,
bool g77,
gfc_init_block (&block);
if (maybe_shift && !keep_descriptor_lower_bound (expr))
- conv_shift_descriptor (&block, se->expr, expr->rank);
+ gfc_conv_shift_descriptor (&block, se->expr, expr->rank);
bool assumed_rank_fsym;
if (fsym
diff --git a/gcc/fortran/trans-array.h b/gcc/fortran/trans-array.h
index 571322ae11ff..378afb9617a3 100644
--- a/gcc/fortran/trans-array.h
+++ b/gcc/fortran/trans-array.h
@@ -216,6 +216,7 @@ tree gfc_get_cfi_dim_sm (tree, tree);
/* Shift lower bound of descriptor, updating ubound and offset. */
void gfc_conv_shift_descriptor_lbound (stmtblock_t*, tree, int, tree);
void gfc_conv_shift_descriptor (stmtblock_t*, tree, const gfc_array_ref &);
+void gfc_conv_shift_descriptor (stmtblock_t*, tree, int);
void gfc_conv_shift_descriptor (stmtblock_t*, tree, tree, int, tree);
/* Add pre-loop scalarization code for intrinsic functions which require
diff --git a/gcc/fortran/trans-stmt.cc b/gcc/fortran/trans-stmt.cc
index e7da8fea3b24..01fb8d91007f 100644
--- a/gcc/fortran/trans-stmt.cc
+++ b/gcc/fortran/trans-stmt.cc
@@ -2007,16 +2007,12 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block
*block)
if ((!sym->assoc->variable && !cst_array_ctor)
|| !whole_array)
{
- int dim;
-
if (whole_array)
gfc_add_modify (&se.pre, desc, se.expr);
/* The generated descriptor has lower bound zero (as array
temporary), shift bounds so we get lower bounds of 1. */
- for (dim = 0; dim < e->rank; ++dim)
- gfc_conv_shift_descriptor_lbound (&se.pre, desc,
- dim, gfc_index_one_node);
+ gfc_conv_shift_descriptor (&se.pre, desc, e->rank);
}
/* If this is a subreference array pointer associate name use the
[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] Factorisation shift descriptor
https://gcc.gnu.org/g:7818e31b1ca1ea4796040325332a850765ef9fdd
commit 7818e31b1ca1ea4796040325332a850765ef9fdd
Author: Mikael Morin
Date: Thu Jan 16 14:51:42 2025 +0100
Factorisation shift descriptor
Diff:
---
gcc/fortran/trans-expr.cc | 7 +--
1 file changed, 1 insertion(+), 6 deletions(-)
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 77e8a55af457..b7d1e3df0613 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -1219,7 +1219,6 @@ gfc_conv_intrinsic_to_class (gfc_se *parmse, gfc_expr *e,
tree ctree;
tree var;
tree tmp;
- int dim;
bool unlimited_poly;
unlimited_poly = class_ts.type == BT_CLASS
@@ -1287,11 +1286,7 @@ gfc_conv_intrinsic_to_class (gfc_se *parmse, gfc_expr *e,
/* Array references with vector subscripts and non-variable
expressions
need be converted to a one-based descriptor. */
if (e->expr_type != EXPR_VARIABLE)
- {
- for (dim = 0; dim < e->rank; ++dim)
- gfc_conv_shift_descriptor_lbound (&parmse->pre, parmse->expr,
- dim, gfc_index_one_node);
- }
+ gfc_conv_shift_descriptor (&parmse->pre, parmse->expr, e->rank);
if (class_ts.u.derived->components->as->rank != e->rank)
{
[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] Factorisation copie gfc_conv_expr_descriptor
https://gcc.gnu.org/g:82413c99dc41ba8b632e751540ba26d97ea67ceb
commit 82413c99dc41ba8b632e751540ba26d97ea67ceb
Author: Mikael Morin
Date: Wed Jan 15 17:51:21 2025 +0100
Factorisation copie gfc_conv_expr_descriptor
Diff:
---
gcc/fortran/trans-array.cc | 37 ++---
1 file changed, 22 insertions(+), 15 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 7d43a8c000d3..097a9a0d860a 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -8989,6 +8989,26 @@ is_explicit_coarray (gfc_expr *expr)
return cas && cas->cotype == AS_EXPLICIT;
}
+
+static void
+copy_descriptor (stmtblock_t *block, tree dest, tree src,
+gfc_expr *src_expr, bool subref)
+{
+ /* Copy the descriptor for pointer assignments. */
+ gfc_add_modify (block, dest, src);
+
+ /* Add any offsets from subreferences. */
+ gfc_get_dataptr_offset (block, dest, src, NULL_TREE, subref, src_expr);
+
+ /* and set the span field. */
+ tree tmp;
+ if (src_expr->ts.type == BT_CHARACTER)
+tmp = gfc_conv_descriptor_span_get (src);
+ else
+tmp = gfc_get_array_span (src, src_expr);
+ gfc_conv_descriptor_span_set (block, dest, tmp);
+}
+
/* Convert an array for passing as an actual argument. Expressions and
vector subscripts are evaluated and stored in a temporary, which is then
passed. For whole arrays the descriptor is passed. For array sections
@@ -9123,21 +9143,8 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr)
if (full && !transposed_dims (ss))
{
if (se->direct_byref && !se->byref_noassign)
- {
- /* Copy the descriptor for pointer assignments. */
- gfc_add_modify (&se->pre, se->expr, desc);
-
- /* Add any offsets from subreferences. */
- gfc_get_dataptr_offset (&se->pre, se->expr, desc, NULL_TREE,
- subref_array_target, expr);
-
- /* and set the span field. */
- if (ss_info->expr->ts.type == BT_CHARACTER)
- tmp = gfc_conv_descriptor_span_get (desc);
- else
- tmp = gfc_get_array_span (desc, expr);
- gfc_conv_descriptor_span_set (&se->pre, se->expr, tmp);
- }
+ copy_descriptor (&se->pre, se->expr, desc, expr,
+subref_array_target);
else if (se->want_pointer)
{
/* We pass full arrays directly. This means that pointers and
[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] Refactor conv_shift_descriptor
https://gcc.gnu.org/g:a6d12d1f09654a5d3038b6042e645dd9da4c84a5
commit a6d12d1f09654a5d3038b6042e645dd9da4c84a5
Author: Mikael Morin
Date: Thu Jan 16 15:28:38 2025 +0100
Refactor conv_shift_descriptor
Correction régressions
Correction régression gfc_conv_expr_descriptor
Diff:
---
gcc/fortran/trans-array.cc | 31 +--
gcc/fortran/trans-array.h | 1 -
2 files changed, 17 insertions(+), 15 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index ecdaad3f9575..bf11689cf3dd 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -1165,16 +1165,15 @@ gfc_build_null_descriptor (tree type)
/* Modify a descriptor such that the lbound of a given dimension is the value
specified. This also updates ubound and offset accordingly. */
-void
-gfc_conv_shift_descriptor_lbound (stmtblock_t* block, tree desc,
- int dim, tree new_lbound)
+static void
+conv_shift_descriptor_lbound (stmtblock_t* block, tree desc, int dim,
+ tree new_lbound, tree offset)
{
- tree offs, ubound, lbound, stride;
+ tree ubound, lbound, stride;
tree diff, offs_diff;
new_lbound = fold_convert (gfc_array_index_type, new_lbound);
- offs = gfc_conv_descriptor_offset_get (desc);
lbound = gfc_conv_descriptor_lbound_get (desc, gfc_rank_cst[dim]);
ubound = gfc_conv_descriptor_ubound_get (desc, gfc_rank_cst[dim]);
stride = gfc_conv_descriptor_stride_get (desc, gfc_rank_cst[dim]);
@@ -1190,9 +1189,9 @@ gfc_conv_shift_descriptor_lbound (stmtblock_t* block,
tree desc,
gfc_conv_descriptor_ubound_set (block, desc, gfc_rank_cst[dim], ubound);
offs_diff = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
diff, stride);
- offs = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
- offs, offs_diff);
- gfc_conv_descriptor_offset_set (block, desc, offs);
+ tree tmp = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
+ offset, offs_diff);
+ gfc_add_modify (block, offset, tmp);
/* Finally set lbound to value we want. */
gfc_conv_descriptor_lbound_set (block, desc, gfc_rank_cst[dim], new_lbound);
@@ -1229,6 +1228,10 @@ static void
conv_shift_descriptor (stmtblock_t *block, tree desc, int rank,
const lb_info &info)
{
+ tree tmp = gfc_conv_descriptor_offset_get (desc);
+ tree offset_var = gfc_create_var (TREE_TYPE (tmp), "offset");
+ gfc_add_modify (block, offset_var, tmp);
+
/* Apply a shift of the lbound when supplied. */
for (int dim = 0; dim < rank; ++dim)
{
@@ -1252,8 +1255,10 @@ conv_shift_descriptor (stmtblock_t *block, tree desc,
int rank,
lower_bound = lb_var;
}
- gfc_conv_shift_descriptor_lbound (block, desc, dim, lower_bound);
+ conv_shift_descriptor_lbound (block, desc, dim, lower_bound, offset_var);
}
+
+ gfc_conv_descriptor_offset_set (block, desc, offset_var);
}
@@ -9225,7 +9230,6 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr)
bool subref_array_target = false;
bool deferred_array_component = false;
bool substr = false;
- bool unlimited_polymorphic = false;
gfc_expr *arg, *ss_expr;
if (se->want_coarray || expr->rank == 0)
@@ -9251,7 +9255,7 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr)
}
if (!se->direct_byref)
-unlimited_polymorphic = UNLIMITED_POLY (expr);
+se->unlimited_polymorphic = UNLIMITED_POLY (expr);
/* Special case things we know we can pass easily. */
switch (expr->expr_type)
@@ -9655,9 +9659,8 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr)
gfc_get_array_span (desc, expr)));
}
-
- set_descriptor (&se->pre, parm, desc, expr, loop.dimen, codim,
- ss, info, loop.from, loop.to, unlimited_polymorphic,
+ set_descriptor (&loop.pre, parm, desc, expr, loop.dimen, codim,
+ ss, info, loop.from, loop.to, se->unlimited_polymorphic,
!se->data_not_needed, subref_array_target);
desc = parm;
diff --git a/gcc/fortran/trans-array.h b/gcc/fortran/trans-array.h
index 378afb9617a3..3f39845c898f 100644
--- a/gcc/fortran/trans-array.h
+++ b/gcc/fortran/trans-array.h
@@ -214,7 +214,6 @@ tree gfc_get_cfi_dim_sm (tree, tree);
/* Shift lower bound of descriptor, updating ubound and offset. */
-void gfc_conv_shift_descriptor_lbound (stmtblock_t*, tree, int, tree);
void gfc_conv_shift_descriptor (stmtblock_t*, tree, const gfc_array_ref &);
void gfc_conv_shift_descriptor (stmtblock_t*, tree, int);
void gfc_conv_shift_descriptor (stmtblock_t*, tree, tree, int, tree);
[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] Essai suppression unlimited_polymorphic
https://gcc.gnu.org/g:bd3573d2425487de1c1d165e86d63ff83037c584
commit bd3573d2425487de1c1d165e86d63ff83037c584
Author: Mikael Morin
Date: Thu Jan 16 20:45:34 2025 +0100
Essai suppression unlimited_polymorphic
Diff:
---
gcc/fortran/trans-array.cc | 13 -
gcc/fortran/trans.h| 3 ---
2 files changed, 4 insertions(+), 12 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index bf11689cf3dd..4f066680dff0 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -9019,7 +9019,7 @@ set_descriptor (stmtblock_t *block, tree dest, tree src,
gfc_expr *src_expr,
int rank, int corank, gfc_ss *ss, gfc_array_info *info,
tree lowers[GFC_MAX_DIMENSIONS],
tree uppers[GFC_MAX_DIMENSIONS],
- bool unlimited_polymorphic, bool data_needed, bool subref)
+ bool data_needed, bool subref)
{
int ndim = info->ref ? info->ref->u.ar.dimen : rank;
@@ -9044,9 +9044,7 @@ set_descriptor (stmtblock_t *block, tree dest, tree src,
gfc_expr *src_expr,
/* Set the dtype. */
tmp = gfc_conv_descriptor_dtype (dest);
tree dtype;
- if (unlimited_polymorphic)
-dtype = gfc_get_dtype (TREE_TYPE (src), &rank);
- else if (src_expr->ts.type == BT_ASSUMED)
+ if (src_expr->ts.type == BT_ASSUMED)
{
tree tmp2 = src;
if (DECL_LANG_SPECIFIC (tmp2) && GFC_DECL_SAVED_DESCRIPTOR (tmp2))
@@ -9056,7 +9054,7 @@ set_descriptor (stmtblock_t *block, tree dest, tree src,
gfc_expr *src_expr,
dtype = gfc_conv_descriptor_dtype (tmp2);
}
else
-dtype = gfc_get_dtype (TREE_TYPE (dest));
+dtype = gfc_get_dtype (TREE_TYPE (src), &rank);
gfc_add_modify (block, tmp, dtype);
/* The 1st element in the section. */
@@ -9254,9 +9252,6 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr)
expr = expr->value.function.actual->expr;
}
- if (!se->direct_byref)
-se->unlimited_polymorphic = UNLIMITED_POLY (expr);
-
/* Special case things we know we can pass easily. */
switch (expr->expr_type)
{
@@ -9660,7 +9655,7 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr)
}
set_descriptor (&loop.pre, parm, desc, expr, loop.dimen, codim,
- ss, info, loop.from, loop.to, se->unlimited_polymorphic,
+ ss, info, loop.from, loop.to,
!se->data_not_needed, subref_array_target);
desc = parm;
diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index 098fb07c1483..197dea0a18a6 100644
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -61,9 +61,6 @@ typedef struct gfc_se
the reference to the class object here. */
tree class_container;
- /* Whether expr is a reference to an unlimited polymorphic object. */
- unsigned unlimited_polymorphic:1;
-
/* If set gfc_conv_variable will return an expression for the array
descriptor. When set, want_pointer should also be set.
If not set scalarizing variables will be substituted. */
[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] Factorisation set_contiguous_array
https://gcc.gnu.org/g:ccb2dcc879e6c3debbd0e010cfc394cfde504fbc
commit ccb2dcc879e6c3debbd0e010cfc394cfde504fbc
Author: Mikael Morin
Date: Fri Jan 17 17:25:59 2025 +0100
Factorisation set_contiguous_array
Diff:
---
gcc/fortran/trans-array.cc | 57 +++---
1 file changed, 29 insertions(+), 28 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 4f066680dff0..76668d8a3ef1 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -10685,6 +10685,23 @@ gfc_caf_is_dealloc_only (int caf_mode)
}
+static void
+set_contiguous_array (stmtblock_t *block, tree desc, tree size, tree data_ptr)
+{
+ gfc_add_modify (block, gfc_conv_descriptor_dtype (desc),
+ gfc_get_dtype_rank_type (1, TREE_TYPE (desc)));
+ gfc_conv_descriptor_lbound_set (block, desc,
+ gfc_index_zero_node,
+ gfc_index_one_node);
+ gfc_conv_descriptor_stride_set (block, desc,
+ gfc_index_zero_node,
+ gfc_index_one_node);
+ gfc_conv_descriptor_ubound_set (block, desc,
+ gfc_index_zero_node, size);
+ gfc_conv_descriptor_data_set (block, desc, data_ptr);
+}
+
+
/* Recursively traverse an object of derived type, generating code to
deallocate, nullify or copy allocatable components. This is the work horse
function for the functions named in this enum. */
@@ -10945,32 +10962,6 @@ structure_alloc_comps (gfc_symbol * der_type, tree
decl, tree dest,
ubound = build_int_cst (gfc_array_index_type, 1);
}
- /* Treat strings like arrays. Or the other way around, do not
- * generate an additional array layer for scalar components. */
- if (attr->dimension || c->ts.type == BT_CHARACTER)
- {
- cdesc = gfc_get_array_type_bounds (tmp, 1, 0, &gfc_index_one_node,
-&ubound, 1,
-GFC_ARRAY_ALLOCATABLE, false);
-
- cdesc = gfc_create_var (cdesc, "cdesc");
- DECL_ARTIFICIAL (cdesc) = 1;
-
- gfc_add_modify (&tmpblock, gfc_conv_descriptor_dtype (cdesc),
- gfc_get_dtype_rank_type (1, tmp));
- gfc_conv_descriptor_lbound_set (&tmpblock, cdesc,
- gfc_index_zero_node,
- gfc_index_one_node);
- gfc_conv_descriptor_stride_set (&tmpblock, cdesc,
- gfc_index_zero_node,
- gfc_index_one_node);
- gfc_conv_descriptor_ubound_set (&tmpblock, cdesc,
- gfc_index_zero_node, ubound);
- }
- else
- /* Prevent warning. */
- cdesc = NULL_TREE;
-
if (attr->dimension)
{
if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (comp)))
@@ -10993,13 +10984,23 @@ structure_alloc_comps (gfc_symbol * der_type, tree
decl, tree dest,
gfc_add_block_to_block (&tmpblock, &se.pre);
}
+ /* Treat strings like arrays. Or the other way around, do not
+ * generate an additional array layer for scalar components. */
if (attr->dimension || c->ts.type == BT_CHARACTER)
- gfc_conv_descriptor_data_set (&tmpblock, cdesc, comp);
+ {
+ cdesc = gfc_get_array_type_bounds (tmp, 1, 0, &gfc_index_one_node,
+&ubound, 1,
+GFC_ARRAY_ALLOCATABLE, false);
+
+ cdesc = gfc_create_var (cdesc, "cdesc");
+ DECL_ARTIFICIAL (cdesc) = 1;
+
+ set_contiguous_array (&tmpblock, cdesc, ubound, comp);
+ }
else
cdesc = comp;
tree fndecl;
-
fndecl = build_call_expr_loc (input_location,
gfor_fndecl_co_broadcast, 5,
gfc_build_addr_expr
(pvoid_type_node,cdesc),
[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] Refactoring gfc_conv_descriptor_sm_get.
https://gcc.gnu.org/g:7d9a5b709d1f2400ea62c334bff7c9d4436a687c
commit 7d9a5b709d1f2400ea62c334bff7c9d4436a687c
Author: Mikael Morin
Date: Wed Jan 22 21:59:46 2025 +0100
Refactoring gfc_conv_descriptor_sm_get.
Diff:
---
gcc/fortran/trans-array.cc | 11 +++
gcc/fortran/trans-array.h | 1 +
gcc/fortran/trans-expr.cc | 4 +---
3 files changed, 13 insertions(+), 3 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 7357626be9a5..4d08a862c5be 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -589,6 +589,17 @@ gfc_conv_descriptor_extent_get (tree desc, tree dim)
}
+tree
+gfc_conv_descriptor_sm_get (tree desc, tree dim)
+{
+ tree stride = gfc_conv_descriptor_stride_get (desc, dim);
+ tree span = gfc_conv_descriptor_span_get (desc);
+
+ return fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
+ stride, span);
+}
+
+
static int
get_type_info (const bt &type)
{
diff --git a/gcc/fortran/trans-array.h b/gcc/fortran/trans-array.h
index 1d694989b4c3..296a8052dd73 100644
--- a/gcc/fortran/trans-array.h
+++ b/gcc/fortran/trans-array.h
@@ -195,6 +195,7 @@ 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_extent_get (tree, tree);
+tree gfc_conv_descriptor_sm_get (tree, tree);
tree gfc_conv_descriptor_token (tree);
void gfc_conv_descriptor_data_set (stmtblock_t *, tree, tree);
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 84111f5e3d3d..6daa4a727f12 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -6262,9 +6262,7 @@ gfc_conv_gfc_desc_to_cfi_desc (gfc_se *parmse, gfc_expr
*e, gfc_symbol *fsym)
tmp = gfc_conv_descriptor_extent_get (gfc, idx);
gfc_add_modify (&loop_body, gfc_get_cfi_dim_extent (cfi, idx), tmp);
/* d->dim[n].sm = gfc->dim[i].stride * gfc->span); */
- tmp = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
-gfc_conv_descriptor_stride_get (gfc, idx),
-gfc_conv_descriptor_span_get (gfc));
+ tmp = gfc_conv_descriptor_sm_get (gfc, idx);
gfc_add_modify (&loop_body, gfc_get_cfi_dim_sm (cfi, idx), tmp);
/* Generate loop. */
[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] Factorisation set_descriptor_from_scalar dans conv_class_to_class
https://gcc.gnu.org/g:60fb6b7d916d2d309ca305c8848baefe06ae06c6
commit 60fb6b7d916d2d309ca305c8848baefe06ae06c6
Author: Mikael Morin
Date: Tue Jan 28 21:03:24 2025 +0100
Factorisation set_descriptor_from_scalar dans conv_class_to_class
Correction régression associate_66
Correction régression PR100040.f90
Diff:
---
gcc/fortran/trans-expr.cc | 34 ++
1 file changed, 22 insertions(+), 12 deletions(-)
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index a5cd0a452d81..6afb344245f2 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -172,6 +172,27 @@ gfc_conv_null_array_descriptor (gfc_se *se, gfc_symbol
*sym, gfc_expr *expr)
}
+void
+set_descriptor_from_scalar (stmtblock_t *block, tree desc, tree scalar,
+ gfc_expr *scalar_expr)
+{
+ tree type = get_scalar_to_descriptor_type (scalar,
+gfc_expr_attr (scalar_expr));
+ if (POINTER_TYPE_P (type))
+type = TREE_TYPE (type);
+
+ tree dtype_val = gfc_get_dtype (type);
+ tree dtype_ref = gfc_conv_descriptor_dtype (desc);
+ gfc_add_modify (block, dtype_ref, dtype_val);
+
+ tree tmp = gfc_class_data_get (scalar);
+ if (!POINTER_TYPE_P (TREE_TYPE (tmp)))
+tmp = gfc_build_addr_expr (NULL_TREE, tmp);
+
+ gfc_conv_descriptor_data_set (block, desc, tmp);
+}
+
+
tree
gfc_conv_scalar_to_descriptor (gfc_se *se, tree scalar, symbol_attribute attr)
{
@@ -1434,18 +1455,7 @@ gfc_conv_class_to_class (gfc_se *parmse, gfc_expr *e,
gfc_typespec class_ts,
&& e->rank != class_ts.u.derived->components->as->rank)
{
if (e->rank == 0)
- {
- tree type = get_scalar_to_descriptor_type (parmse->expr,
-gfc_expr_attr (e));
- gfc_add_modify (&block, gfc_conv_descriptor_dtype (ctree),
- gfc_get_dtype (type));
-
- tmp = gfc_class_data_get (parmse->expr);
- if (!POINTER_TYPE_P (TREE_TYPE (tmp)))
- tmp = gfc_build_addr_expr (NULL_TREE, tmp);
-
- gfc_conv_descriptor_data_set (&block, ctree, tmp);
- }
+ set_descriptor_from_scalar (&block, ctree, parmse->expr, e);
else
gfc_class_array_data_assign (&block, ctree, parmse->expr, false);
}
[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] Factorisation set_descriptor_from_scalar dans gfc_conv_scalar_to_descriptor
https://gcc.gnu.org/g:01b40a54c893abe13bf134397e2f1651e4088d58
commit 01b40a54c893abe13bf134397e2f1651e4088d58
Author: Mikael Morin
Date: Wed Jan 29 19:05:04 2025 +0100
Factorisation set_descriptor_from_scalar dans gfc_conv_scalar_to_descriptor
Correction régression pr49213.f90
Correction régression associated_assumed_rank.f90
Diff:
---
gcc/fortran/trans-expr.cc | 67 +++
1 file changed, 38 insertions(+), 29 deletions(-)
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 091e1417faed..860224066167 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -174,46 +174,61 @@ gfc_conv_null_array_descriptor (gfc_se *se, gfc_symbol
*sym, gfc_expr *expr)
void
set_descriptor_from_scalar (stmtblock_t *block, tree desc, tree scalar,
- gfc_expr *scalar_expr, bool is_class,
+ symbol_attribute scalar_attr, bool is_class,
tree cond_optional)
{
- tree type = get_scalar_to_descriptor_type (scalar,
-gfc_expr_attr (scalar_expr));
+ tree type = get_scalar_to_descriptor_type (scalar, scalar_attr);
if (POINTER_TYPE_P (type))
type = TREE_TYPE (type);
- tree dtype_val = gfc_get_dtype (type);
+ tree etype = gfc_get_element_type (type);
+ tree dtype_val;
+ if (etype == void_type_node)
+dtype_val = gfc_get_dtype_rank_type (0, TREE_TYPE (scalar));
+ else
+dtype_val = gfc_get_dtype (type);
+
tree dtype_ref = gfc_conv_descriptor_dtype (desc);
gfc_add_modify (block, dtype_ref, dtype_val);
- tree tmp;
- if (is_class)
+ gfc_conv_descriptor_span_set (block, desc, integer_zero_node);
+
+ if (CONSTANT_CLASS_P (scalar))
{
- tmp = gfc_class_data_get (scalar);
- if (!POINTER_TYPE_P (TREE_TYPE (tmp)))
- tmp = gfc_build_addr_expr (NULL_TREE, tmp);
+ tree tmp;
+ tmp = gfc_create_var (TREE_TYPE (scalar), "scalar");
+ gfc_add_modify (block, tmp, scalar);
+ scalar = tmp;
}
- else if (cond_optional)
+
+ tree tmp;
+ if (is_class)
+tmp = gfc_class_data_get (scalar);
+ else
+tmp = scalar;
+
+ if (!POINTER_TYPE_P (TREE_TYPE (tmp)))
+tmp = gfc_build_addr_expr (NULL_TREE, tmp);
+
+ if (cond_optional)
{
- tmp = build3_loc (input_location, COND_EXPR, TREE_TYPE (scalar),
- cond_optional, scalar,
+ tmp = build3_loc (input_location, COND_EXPR, TREE_TYPE (tmp),
+ cond_optional, tmp,
fold_convert (TREE_TYPE (scalar),
null_pointer_node));
}
- else
-tmp = scalar;
gfc_conv_descriptor_data_set (block, desc, tmp);
}
+
tree
gfc_conv_scalar_to_descriptor (gfc_se *se, tree scalar, symbol_attribute attr)
{
- tree desc, type, etype;
+ tree desc, type;
type = get_scalar_to_descriptor_type (scalar, attr);
- etype = TREE_TYPE (scalar);
desc = gfc_create_var (type, "desc");
DECL_ARTIFICIAL (desc) = 1;
@@ -224,15 +239,9 @@ gfc_conv_scalar_to_descriptor (gfc_se *se, tree scalar,
symbol_attribute attr)
gfc_add_modify (&se->pre, tmp, scalar);
scalar = tmp;
}
- if (!POINTER_TYPE_P (TREE_TYPE (scalar)))
-scalar = gfc_build_addr_expr (NULL_TREE, scalar);
- else if (TREE_TYPE (etype) && TREE_CODE (TREE_TYPE (etype)) == ARRAY_TYPE)
-etype = TREE_TYPE (etype);
- gfc_add_modify (&se->pre, gfc_conv_descriptor_dtype (desc),
- gfc_get_dtype_rank_type (0, etype));
- gfc_conv_descriptor_data_set (&se->pre, desc, scalar);
- gfc_conv_descriptor_span_set (&se->pre, desc,
- gfc_conv_descriptor_elem_len (desc));
+
+ set_descriptor_from_scalar (&se->pre, desc, scalar, attr,
+ false, NULL_TREE);
/* Copy pointer address back - but only if it could have changed and
if the actual argument is a pointer and not, e.g., NULL(). */
@@ -1082,8 +1091,8 @@ gfc_conv_derived_to_class (gfc_se *parmse, gfc_expr *e,
gfc_symbol *fsym,
/* Scalar to an assumed-rank array. */
if (fsym->ts.u.derived->components->as)
set_descriptor_from_scalar (&parmse->pre, ctree,
- parmse->expr, e, false,
- cond_optional);
+ parmse->expr, gfc_expr_attr (e),
+ false, cond_optional);
else
{
tmp = fold_convert (TREE_TYPE (ctree), parmse->expr);
@@ -1458,8 +1467,8 @@ gfc_conv_class_to_class (gfc_se *parmse, gfc_expr *e,
gfc_typespec class_ts,
&& e->rank != class_ts.u.derived->components->as->rank)
{
if (e->rank == 0)
- set_descriptor_from_scalar (&block, ctree, parmse->expr, e,
- true, NULL_TREE);
+ set_descriptor_from_scalar (&block, ctree, pa
[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] Factorisation initialisation subarray_descriptor
https://gcc.gnu.org/g:41e38348a930505eacdc9386c9fce31a40bdbdb2
commit 41e38348a930505eacdc9386c9fce31a40bdbdb2
Author: Mikael Morin
Date: Tue Jan 21 18:44:41 2025 +0100
Factorisation initialisation subarray_descriptor
Diff:
---
gcc/fortran/trans-expr.cc | 151 --
1 file changed, 78 insertions(+), 73 deletions(-)
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index b7d1e3df0613..65b6cd8a4642 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -9418,17 +9418,90 @@ gfc_trans_subarray_assign (tree dest, gfc_component *
cm, gfc_expr * expr)
}
+static void
+set_subarray_descriptor (stmtblock_t *block, tree desc, tree value,
+gfc_expr *value_expr, gfc_expr *conv_arg)
+{
+ if (value_expr->expr_type != EXPR_VARIABLE)
+gfc_conv_descriptor_data_set (block, value,
+ null_pointer_node);
+
+ /* Obtain the array spec of full array references. */
+ gfc_array_spec *as;
+ if (conv_arg)
+as = gfc_get_full_arrayspec_from_expr (conv_arg);
+ else
+as = gfc_get_full_arrayspec_from_expr (value_expr);
+
+ /* Shift the lbound and ubound of temporaries to being unity,
+ rather than zero, based. Always calculate the offset. */
+ tree offset = gfc_conv_descriptor_offset_get (desc);
+ gfc_add_modify (block, offset, gfc_index_zero_node);
+ tree tmp2 = gfc_create_var (gfc_array_index_type, NULL);
+
+ for (int n = 0; n < value_expr->rank; n++)
+{
+ tree span;
+ tree lbound;
+
+ /* Obtain the correct lbound - ISO/IEC TR 15581:2001 page 9.
+TODO It looks as if gfc_conv_expr_descriptor should return
+the correct bounds and that the following should not be
+necessary. This would simplify gfc_conv_intrinsic_bound
+as well. */
+ if (as && as->lower[n])
+ {
+ gfc_se lbse;
+ gfc_init_se (&lbse, NULL);
+ gfc_conv_expr (&lbse, as->lower[n]);
+ gfc_add_block_to_block (block, &lbse.pre);
+ lbound = gfc_evaluate_now (lbse.expr, block);
+ }
+ else if (as && conv_arg)
+ {
+ tree tmp = gfc_get_symbol_decl (conv_arg->symtree->n.sym);
+ lbound = gfc_conv_descriptor_lbound_get (tmp,
+ gfc_rank_cst[n]);
+ }
+ else if (as)
+ lbound = gfc_conv_descriptor_lbound_get (desc,
+ gfc_rank_cst[n]);
+ else
+ lbound = gfc_index_one_node;
+
+ lbound = fold_convert (gfc_array_index_type, lbound);
+
+ /* Shift the bounds and set the offset accordingly. */
+ tree tmp = gfc_conv_descriptor_ubound_get (desc, gfc_rank_cst[n]);
+ span = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
+ tmp, gfc_conv_descriptor_lbound_get (desc, gfc_rank_cst[n]));
+ tmp = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
+span, lbound);
+ gfc_conv_descriptor_ubound_set (block, desc,
+ gfc_rank_cst[n], tmp);
+ gfc_conv_descriptor_lbound_set (block, desc,
+ gfc_rank_cst[n], lbound);
+
+ tmp = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
+gfc_conv_descriptor_lbound_get (desc,
+gfc_rank_cst[n]),
+gfc_conv_descriptor_stride_get (desc,
+gfc_rank_cst[n]));
+ gfc_add_modify (block, tmp2, tmp);
+ tmp = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
+offset, tmp2);
+ gfc_conv_descriptor_offset_set (block, desc, tmp);
+}
+}
+
+
static tree
gfc_trans_alloc_subarray_assign (tree dest, gfc_component * cm,
gfc_expr * expr)
{
gfc_se se;
stmtblock_t block;
- tree offset;
- int n;
tree tmp;
- tree tmp2;
- gfc_array_spec *as;
gfc_expr *arg = NULL;
gfc_start_block (&block);
@@ -9489,10 +9562,6 @@ gfc_trans_alloc_subarray_assign (tree dest,
gfc_component * cm,
gfc_add_expr_to_block (&block, tmp);
gfc_add_block_to_block (&block, &se.post);
- if (expr->expr_type != EXPR_VARIABLE)
-gfc_conv_descriptor_data_set (&block, se.expr,
- null_pointer_node);
-
/* We need to know if the argument of a conversion function is a
variable, so that the correct lower bound can be used. */
if (expr->expr_type == EXPR_FUNCTION
@@ -9502,71 +9571,7 @@ gfc_trans_alloc_subarray_assign (tree dest,
gfc_component * cm,
&& expr->value.function.actual->expr->expr_type == EXPR_VARIABLE)
arg = expr->value.function.actual->expr;
- /* Obtain the array spec of full array references. */
- if (arg)
-as = gfc_get_full_arrayspec_from_expr (arg);
- else
-a
[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] Factorisation set descriptor with shape
https://gcc.gnu.org/g:c3a50c1a8cb83384345d3dc3530fbb9b830d6e85
commit c3a50c1a8cb83384345d3dc3530fbb9b830d6e85
Author: Mikael Morin
Date: Fri Jan 17 21:46:27 2025 +0100
Factorisation set descriptor with shape
Diff:
---
gcc/fortran/trans-array.cc | 78 ++
gcc/fortran/trans-array.h | 2 ++
gcc/fortran/trans-intrinsic.cc | 76 +++-
3 files changed, 85 insertions(+), 71 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 88a2509a5246..b05f69fdd874 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -1566,6 +1566,84 @@ copy_descriptor (stmtblock_t *block, tree dest, tree src,
gfc_conv_descriptor_span_set (block, dest, tmp);
}
+
+void
+gfc_set_descriptor_with_shape (stmtblock_t *block, tree desc,
+ tree ptr, gfc_expr *shape,
+ locus *where)
+{
+ /* Set the span field. */
+ tree tmp = TYPE_SIZE_UNIT (gfc_get_element_type (TREE_TYPE (desc)));
+ tmp = fold_convert (gfc_array_index_type, tmp);
+ gfc_conv_descriptor_span_set (block, desc, tmp);
+
+ /* Set data value, dtype, and offset. */
+ tmp = GFC_TYPE_ARRAY_DATAPTR_TYPE (TREE_TYPE (desc));
+ gfc_conv_descriptor_data_set (block, desc, fold_convert (tmp, ptr));
+ gfc_add_modify (block, gfc_conv_descriptor_dtype (desc),
+ gfc_get_dtype (TREE_TYPE (desc)));
+
+ /* Start scalarization of the bounds, using the shape argument. */
+
+ gfc_ss *shape_ss = gfc_walk_expr (shape);
+ gcc_assert (shape_ss != gfc_ss_terminator);
+ gfc_se shapese;
+ gfc_init_se (&shapese, NULL);
+
+ gfc_loopinfo loop;
+ gfc_init_loopinfo (&loop);
+ gfc_add_ss_to_loop (&loop, shape_ss);
+ gfc_conv_ss_startstride (&loop);
+ gfc_conv_loop_setup (&loop, where);
+ gfc_mark_ss_chain_used (shape_ss, 1);
+
+ gfc_copy_loopinfo_to_se (&shapese, &loop);
+ shapese.ss = shape_ss;
+
+ tree stride = gfc_create_var (gfc_array_index_type, "stride");
+ tree offset = gfc_create_var (gfc_array_index_type, "offset");
+ gfc_add_modify (block, stride, gfc_index_one_node);
+ gfc_add_modify (block, offset, gfc_index_zero_node);
+
+ /* Loop body. */
+ stmtblock_t body;
+ gfc_start_scalarized_body (&loop, &body);
+
+ tree dim = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
+ loop.loopvar[0], loop.from[0]);
+
+ /* Set bounds and stride. */
+ gfc_conv_descriptor_lbound_set (&body, desc, dim, gfc_index_one_node);
+ gfc_conv_descriptor_stride_set (&body, desc, dim, stride);
+
+ gfc_conv_expr (&shapese, shape);
+ gfc_add_block_to_block (&body, &shapese.pre);
+ gfc_conv_descriptor_ubound_set (&body, desc, dim, shapese.expr);
+ gfc_add_block_to_block (&body, &shapese.post);
+
+ /* Calculate offset. */
+ gfc_add_modify (&body, offset,
+ fold_build2_loc (input_location, PLUS_EXPR,
+ gfc_array_index_type, offset, stride));
+ /* Update stride. */
+ gfc_add_modify (&body, stride,
+ fold_build2_loc (input_location, MULT_EXPR,
+ gfc_array_index_type, stride,
+ fold_convert (gfc_array_index_type,
+shapese.expr)));
+ /* Finish scalarization loop. */
+ gfc_trans_scalarizing_loops (&loop, &body);
+ gfc_add_block_to_block (block, &loop.pre);
+ gfc_add_block_to_block (block, &loop.post);
+ gfc_cleanup_loop (&loop);
+
+ gfc_add_modify (block, offset,
+ fold_build1_loc (input_location, NEGATE_EXPR,
+ gfc_array_index_type, offset));
+ gfc_conv_descriptor_offset_set (block, desc, offset);
+}
+
+
/* Obtain offsets for trans-types.cc(gfc_get_array_descr_info). */
void
diff --git a/gcc/fortran/trans-array.h b/gcc/fortran/trans-array.h
index 3f39845c898f..05ea68d531ac 100644
--- a/gcc/fortran/trans-array.h
+++ b/gcc/fortran/trans-array.h
@@ -145,6 +145,8 @@ void gfc_clear_descriptor (stmtblock_t *block, gfc_symbol
*, tree);
void gfc_nullify_descriptor (stmtblock_t *block, gfc_expr *, tree);
void gfc_clear_descriptor (stmtblock_t *block, gfc_symbol *, gfc_expr *, tree);
void gfc_set_scalar_descriptor (stmtblock_t *block, tree, gfc_symbol *,
gfc_expr *, tree);
+void gfc_set_descriptor_with_shape (stmtblock_t *, tree, tree,
+ gfc_expr *, locus *);
/* Get a single array element. */
void gfc_conv_array_ref (gfc_se *, gfc_array_ref *, gfc_expr *, locus *);
diff --git a/gcc/fortran/trans-intrinsic.cc b/gcc/fortran/trans-intrinsic.cc
index b6900d734afd..5d77f3d768a6 100644
--- a/gcc/fortran/trans-intrinsic.cc
+++ b/gcc/fortran/trans-intrinsic.cc
@@ -10482,11 +10482,8 @@ conv_isocbinding_subroutine (gfc_code *code)
gfc_se se;
gfc_se cptrse;
gfc_se fptrse;
- gfc_se shapese;
- gfc_ss *shape_ss;
- tree desc, dim, tmp, stride, offset;
- stmtbl
[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] Factorisation initialisation gfc depuis cfi
https://gcc.gnu.org/g:57a9d2504fe45acda17cd2b7efa99495c276f4df
commit 57a9d2504fe45acda17cd2b7efa99495c276f4df
Author: Mikael Morin
Date: Thu Jan 23 20:46:59 2025 +0100
Factorisation initialisation gfc depuis cfi
Correction régression scalar descriptor
Diff:
---
gcc/fortran/trans-expr.cc | 132 +-
1 file changed, 72 insertions(+), 60 deletions(-)
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 6daa4a727f12..95b168fe76a8 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -5936,6 +5936,75 @@ set_dtype_for_unallocated (gfc_se *parmse, gfc_expr *e)
#endif
+static void
+set_gfc_from_cfi (stmtblock_t *block, tree gfc, tree cfi, tree rank,
+ gfc_symbol *c_sym)
+{
+ tree tmp = gfc_get_cfi_desc_base_addr (cfi);
+ gfc_conv_descriptor_data_set (block, gfc, tmp);
+
+ if (c_sym->attr.allocatable)
+{
+ /* gfc->span = cfi->elem_len. */
+ tmp = fold_convert (gfc_array_index_type,
+ gfc_get_cfi_dim_sm (cfi, gfc_rank_cst[0]));
+}
+ else
+{
+ /* gfc->span = ((cfi->dim[0].sm % cfi->elem_len)
+ ? cfi->dim[0].sm : cfi->elem_len). */
+ tmp = gfc_get_cfi_dim_sm (cfi, gfc_rank_cst[0]);
+ tree tmp2 = fold_convert (gfc_array_index_type,
+ gfc_get_cfi_desc_elem_len (cfi));
+ tmp = fold_build2_loc (input_location, TRUNC_MOD_EXPR,
+gfc_array_index_type, tmp, tmp2);
+ tmp = fold_build2_loc (input_location, NE_EXPR, boolean_type_node,
+tmp, gfc_index_zero_node);
+ tmp = build3_loc (input_location, COND_EXPR, gfc_array_index_type, tmp,
+ gfc_get_cfi_dim_sm (cfi, gfc_rank_cst[0]), tmp2);
+}
+ gfc_conv_descriptor_span_set (block, gfc, tmp);
+
+ /* Calculate offset + set lbound, ubound and stride. */
+ gfc_conv_descriptor_offset_set (block, gfc, gfc_index_zero_node);
+ /* Loop: for (i = 0; i < rank; ++i). */
+ tree idx = gfc_create_var (TREE_TYPE (rank), "idx");
+ /* Loop body. */
+ stmtblock_t loop_body;
+ gfc_init_block (&loop_body);
+ /* gfc->dim[i].lbound = ... */
+ tmp = gfc_get_cfi_dim_lbound (cfi, idx);
+ gfc_conv_descriptor_lbound_set (&loop_body, gfc, idx, tmp);
+
+ /* gfc->dim[i].ubound = gfc->dim[i].lbound + cfi->dim[i].extent - 1. */
+ tmp = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
+gfc_conv_descriptor_lbound_get (gfc, idx),
+gfc_index_one_node);
+ tmp = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
+gfc_get_cfi_dim_extent (cfi, idx), tmp);
+ gfc_conv_descriptor_ubound_set (&loop_body, gfc, idx, tmp);
+
+ /* gfc->dim[i].stride = cfi->dim[i].sm / cfi>elem_len */
+ tmp = gfc_get_cfi_dim_sm (cfi, idx);
+ tmp = fold_build2_loc (input_location, TRUNC_DIV_EXPR,
+gfc_array_index_type, tmp,
+fold_convert (gfc_array_index_type,
+ gfc_get_cfi_desc_elem_len (cfi)));
+ gfc_conv_descriptor_stride_set (&loop_body, gfc, idx, tmp);
+
+ /* gfc->offset -= gfc->dim[i].stride * gfc->dim[i].lbound. */
+ tmp = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
+gfc_conv_descriptor_stride_get (gfc, idx),
+gfc_conv_descriptor_lbound_get (gfc, idx));
+ tmp = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
+gfc_conv_descriptor_offset_get (gfc), tmp);
+ gfc_conv_descriptor_offset_set (&loop_body, gfc, tmp);
+ /* Generate loop. */
+ gfc_simple_for_loop (block, idx, build_int_cst (TREE_TYPE (idx), 0),
+ rank, LT_EXPR, build_int_cst (TREE_TYPE (idx), 1),
+ gfc_finish_block (&loop_body));
+}
+
/* Provide an interface between gfortran array descriptors and the F2018:18.4
ISO_Fortran_binding array descriptors. */
@@ -6315,8 +6384,10 @@ done:
goto post_call;
gfc_init_block (&block2);
+
if (e->rank == 0)
{
+ gfc_init_block (&block2);
tmp = gfc_get_cfi_desc_base_addr (cfi);
gfc_add_modify (&block, gfc, fold_convert (TREE_TYPE (gfc), tmp));
}
@@ -6325,66 +6396,7 @@ done:
tmp = gfc_get_cfi_desc_base_addr (cfi);
gfc_conv_descriptor_data_set (&block, gfc, tmp);
- if (fsym->attr.allocatable)
- {
- /* gfc->span = cfi->elem_len. */
- tmp = fold_convert (gfc_array_index_type,
- gfc_get_cfi_dim_sm (cfi, gfc_rank_cst[0]));
- }
- else
- {
- /* gfc->span = ((cfi->dim[0].sm % cfi->elem_len)
- ? cfi->dim[0].sm : cfi->elem_len). */
- tmp = gfc_get_cfi_dim_sm (cfi, gfc_rank_cst[0]);
- tmp2 = fold_convert (gfc_array_index_type,
- gfc_get_cfi_desc_elem_len (cfi
[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] Introduction gfc_conv_descriptor_extent_get
https://gcc.gnu.org/g:55a2a1029553f80b56f5a8c5ef8a5935c0dd1088
commit 55a2a1029553f80b56f5a8c5ef8a5935c0dd1088
Author: Mikael Morin
Date: Wed Jan 22 19:02:13 2025 +0100
Introduction gfc_conv_descriptor_extent_get
Diff:
---
gcc/fortran/trans-array.cc | 84 ++
gcc/fortran/trans-array.h | 1 +
gcc/fortran/trans-expr.cc | 6 +---
3 files changed, 50 insertions(+), 41 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 7afa29746e08..7357626be9a5 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -544,6 +544,51 @@ gfc_conv_descriptor_ubound_set (stmtblock_t *block, tree
desc,
}
+/* Calculate the size of a given array dimension from the bounds. This
+ is simply (ubound - lbound + 1) if this expression is positive
+ or 0 if it is negative (pick either one if it is zero). Optionally
+ (if or_expr is present) OR the (expression != 0) condition to it. */
+
+static tree
+conv_array_extent_dim (tree lbound, tree ubound, bool maybe_negative, tree*
or_expr)
+{
+ tree res;
+ tree cond;
+
+ /* Calculate (ubound - lbound + 1). */
+ res = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
+ubound, lbound);
+ res = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type, res,
+gfc_index_one_node);
+
+ /* Check whether the size for this dimension is negative. */
+ if (maybe_negative)
+{
+ cond = fold_build2_loc (input_location, LE_EXPR, logical_type_node, res,
+ gfc_index_zero_node);
+ res = fold_build3_loc (input_location, COND_EXPR, gfc_array_index_type,
cond,
+gfc_index_zero_node, res);
+}
+
+ /* Build OR expression. */
+ if (maybe_negative && or_expr)
+*or_expr = fold_build2_loc (input_location, TRUTH_OR_EXPR,
+ logical_type_node, *or_expr, cond);
+
+ return res;
+}
+
+
+tree
+gfc_conv_descriptor_extent_get (tree desc, tree dim)
+{
+ tree ubound = gfc_conv_descriptor_ubound_get (desc, dim);
+ tree lbound = gfc_conv_descriptor_lbound_get (desc, dim);
+
+ return conv_array_extent_dim (lbound, ubound, false, NULL);
+}
+
+
static int
get_type_info (const bt &type)
{
@@ -7111,30 +7156,9 @@ gfc_set_delta (gfc_loopinfo *loop)
tree
gfc_conv_array_extent_dim (tree lbound, tree ubound, tree* or_expr)
{
- tree res;
- tree cond;
-
- /* Calculate (ubound - lbound + 1). */
- res = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
-ubound, lbound);
- res = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type, res,
-gfc_index_one_node);
-
- /* Check whether the size for this dimension is negative. */
- cond = fold_build2_loc (input_location, LE_EXPR, logical_type_node, res,
- gfc_index_zero_node);
- res = fold_build3_loc (input_location, COND_EXPR, gfc_array_index_type, cond,
-gfc_index_zero_node, res);
-
- /* Build OR expression. */
- if (or_expr)
-*or_expr = fold_build2_loc (input_location, TRUTH_OR_EXPR,
- logical_type_node, *or_expr, cond);
-
- return res;
+ return conv_array_extent_dim (lbound, ubound, true, or_expr);
}
-
/* For an array descriptor, get the total number of elements. This is just
the product of the extents along from_dim to to_dim. */
@@ -7148,14 +7172,7 @@ gfc_conv_descriptor_size_1 (tree desc, int from_dim, int
to_dim)
for (dim = from_dim; dim < to_dim; ++dim)
{
- tree lbound;
- tree ubound;
- tree extent;
-
- lbound = gfc_conv_descriptor_lbound_get (desc, gfc_rank_cst[dim]);
- ubound = gfc_conv_descriptor_ubound_get (desc, gfc_rank_cst[dim]);
-
- extent = gfc_conv_array_extent_dim (lbound, ubound, NULL);
+ tree extent = gfc_conv_descriptor_extent_get (desc, gfc_rank_cst[dim]);
res = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
res, extent);
}
@@ -10543,12 +10560,7 @@ gfc_full_array_size (stmtblock_t *block, tree decl,
int rank)
tree nelems;
tree tmp;
idx = gfc_rank_cst[rank - 1];
- nelems = gfc_conv_descriptor_ubound_get (decl, idx);
- tmp = gfc_conv_descriptor_lbound_get (decl, idx);
- tmp = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
-nelems, tmp);
- tmp = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
-tmp, gfc_index_one_node);
+ tmp = gfc_conv_descriptor_extent_get (decl, idx);
tmp = gfc_evaluate_now (tmp, block);
nelems = gfc_conv_descriptor_stride_get (decl, idx);
diff --git a/gcc/fortran/trans-array.h b/gcc/fortran/trans-array.h
index f9988a5fd109..1d694989b4c3 100644
--- a/gcc/fortran/trans-array.h
+++ b/gcc/fortran/trans-array.h
@@ -194,6 +194,7 @@ tree gfc_get_descriptor_
[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] utilisation booléen allocatable
https://gcc.gnu.org/g:84be5a435f2a78f8a9ab0bdf5b693a1e0c6b6fd5
commit 84be5a435f2a78f8a9ab0bdf5b693a1e0c6b6fd5
Author: Mikael Morin
Date: Thu Jan 23 21:38:24 2025 +0100
utilisation booléen allocatable
Diff:
---
gcc/fortran/trans-expr.cc | 6 +++---
1 file changed, 3 insertions(+), 3 deletions(-)
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 95b168fe76a8..518a5a127cf0 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -5938,12 +5938,12 @@ set_dtype_for_unallocated (gfc_se *parmse, gfc_expr *e)
static void
set_gfc_from_cfi (stmtblock_t *block, tree gfc, tree cfi, tree rank,
- gfc_symbol *c_sym)
+ bool allocatable)
{
tree tmp = gfc_get_cfi_desc_base_addr (cfi);
gfc_conv_descriptor_data_set (block, gfc, tmp);
- if (c_sym->attr.allocatable)
+ if (allocatable)
{
/* gfc->span = cfi->elem_len. */
tmp = fold_convert (gfc_array_index_type,
@@ -6396,7 +6396,7 @@ done:
tmp = gfc_get_cfi_desc_base_addr (cfi);
gfc_conv_descriptor_data_set (&block, gfc, tmp);
- set_gfc_from_cfi (&block2, gfc, cfi, rank, fsym);
+ set_gfc_from_cfi (&block2, gfc, cfi, rank, fsym->attr.allocatable);
}
if (e->ts.type == BT_CHARACTER && !e->ts.u.cl->length)
[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] Factorisation shift descriptor
https://gcc.gnu.org/g:c2ce7393ce79293896ae05dcfff402ffea2c9176
commit c2ce7393ce79293896ae05dcfff402ffea2c9176
Author: Mikael Morin
Date: Tue Jan 21 22:27:02 2025 +0100
Factorisation shift descriptor
Diff:
---
gcc/fortran/trans-array.cc | 117 -
gcc/fortran/trans-array.h | 1 +
gcc/fortran/trans-expr.cc | 82 ++-
3 files changed, 100 insertions(+), 100 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index b05f69fdd874..7afa29746e08 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -1198,16 +1198,52 @@ conv_shift_descriptor_lbound (stmtblock_t* block, tree
desc, int dim,
}
-class lb_info
+class lb_info_base
{
public:
+ virtual tree lower_bound (stmtblock_t *block, int dim) const = 0;
+};
+
+
+class lb_info : public lb_info_base
+{
+public:
+ using lb_info_base::lower_bound;
virtual gfc_expr *lower_bound (int dim) const = 0;
+ virtual tree lower_bound (stmtblock_t *block, int dim) const;
};
+tree
+lb_info::lower_bound (stmtblock_t *block, int dim) const
+{
+ gfc_expr *lb_expr = lower_bound(dim);
+
+ if (lb_expr == nullptr)
+return gfc_index_one_node;
+ else
+{
+ gfc_se lb_se;
+
+ gfc_init_se (&lb_se, nullptr);
+ gfc_conv_expr (&lb_se, lb_expr);
+
+ gfc_add_block_to_block (block, &lb_se.pre);
+ tree lb_var = gfc_create_var (gfc_array_index_type, "lower_bound");
+ gfc_add_modify (block, lb_var,
+ fold_convert (gfc_array_index_type, lb_se.expr));
+ gfc_add_block_to_block (block, &lb_se.post);
+
+ return lb_var;
+}
+}
+
+
+
class unset_lb : public lb_info
{
public:
+ using lb_info::lower_bound;
virtual gfc_expr *lower_bound (int) const { return nullptr; }
};
@@ -1218,6 +1254,7 @@ class defined_lb : public lb_info
gfc_expr * const * lower_bounds;
public:
+ using lb_info::lower_bound;
defined_lb (int arg_rank, gfc_expr * const
arg_lower_bounds[GFC_MAX_DIMENSIONS])
: rank(arg_rank), lower_bounds(arg_lower_bounds) { }
virtual gfc_expr *lower_bound (int dim) const { return lower_bounds[dim]; }
@@ -1226,7 +1263,7 @@ public:
static void
conv_shift_descriptor (stmtblock_t *block, tree desc, int rank,
- const lb_info &info)
+ const lb_info_base &info)
{
tree tmp = gfc_conv_descriptor_offset_get (desc);
tree offset_var = gfc_create_var (TREE_TYPE (tmp), "offset");
@@ -1235,26 +1272,7 @@ conv_shift_descriptor (stmtblock_t *block, tree desc,
int rank,
/* Apply a shift of the lbound when supplied. */
for (int dim = 0; dim < rank; ++dim)
{
- gfc_expr *lb_expr = info.lower_bound(dim);
-
- tree lower_bound;
- if (lb_expr == nullptr)
- lower_bound = gfc_index_one_node;
- else
- {
- gfc_se lb_se;
-
- gfc_init_se (&lb_se, nullptr);
- gfc_conv_expr (&lb_se, lb_expr);
-
- gfc_add_block_to_block (block, &lb_se.pre);
- tree lb_var = gfc_create_var (TREE_TYPE (lb_se.expr), "lower_bound");
- gfc_add_modify (block, lb_var, lb_se.expr);
- gfc_add_block_to_block (block, &lb_se.post);
-
- lower_bound = lb_var;
- }
-
+ tree lower_bound = info.lower_bound (block, dim);
conv_shift_descriptor_lbound (block, desc, dim, lower_bound, offset_var);
}
@@ -1337,6 +1355,61 @@ gfc_conv_shift_descriptor (stmtblock_t *block, tree desc,
}
+class dataref_lb : public lb_info_base
+{
+ gfc_array_spec *as;
+ gfc_expr *conv_arg;
+ tree desc;
+
+public:
+ dataref_lb (gfc_array_spec *arg_as, gfc_expr *arg_conv_arg, tree arg_desc)
+: as(arg_as), conv_arg (arg_conv_arg), desc (arg_desc)
+ {}
+ virtual tree lower_bound (stmtblock_t *block, int dim) const;
+};
+
+
+tree
+dataref_lb::lower_bound (stmtblock_t *block, int dim) const
+{
+ tree lbound;
+ if (as && as->lower[dim])
+{
+ gfc_se lbse;
+ gfc_init_se (&lbse, NULL);
+ gfc_conv_expr (&lbse, as->lower[dim]);
+ gfc_add_block_to_block (block, &lbse.pre);
+ lbound = gfc_evaluate_now (lbse.expr, block);
+}
+ else if (as && conv_arg)
+{
+ tree tmp = gfc_get_symbol_decl (conv_arg->symtree->n.sym);
+ lbound = gfc_conv_descriptor_lbound_get (tmp, gfc_rank_cst[dim]);
+}
+ else if (as)
+lbound = gfc_conv_descriptor_lbound_get (desc, gfc_rank_cst[dim]);
+ else
+lbound = gfc_index_one_node;
+
+ return fold_convert (gfc_array_index_type, lbound);
+}
+
+
+void
+gfc_conv_shift_descriptor_subarray (stmtblock_t *block, tree desc,
+ gfc_expr *value_expr, gfc_expr *conv_arg)
+{
+ /* Obtain the array spec of full array references. */
+ gfc_array_spec *as;
+ if (conv_arg)
+as = gfc_get_full_arrayspec_from_expr (conv_arg);
+ else
+as = gfc_get_full_arrayspec_from_expr (value_expr);
+
+ conv_shift_descriptor (block, desc, value_expr->rank, dataref_lb (as,
conv
[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] Annulation modif dump assumed_rank_12.f90
https://gcc.gnu.org/g:ac8ccbd19b684c86649d332a17e71a8d40ae6bbb
commit ac8ccbd19b684c86649d332a17e71a8d40ae6bbb
Author: Mikael Morin
Date: Wed Feb 5 11:45:00 2025 +0100
Annulation modif dump assumed_rank_12.f90
Diff:
---
gcc/fortran/trans-array.cc | 126 -
1 file changed, 124 insertions(+), 2 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 90eafe7ffe18..531281049646 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -1085,11 +1085,131 @@ field_count (tree type)
}
-bool
+#if 0
+static bool
complete_init_p (tree type, vec *init_values)
{
return (unsigned) field_count (type) == vec_safe_length (init_values);
}
+#endif
+
+
+static int
+cmp_wi (const void *x, const void *y)
+{
+ const offset_int *wix = (const offset_int *) x;
+ const offset_int *wiy = (const offset_int *) y;
+
+ return wi::cmpu (*wix, *wiy);
+}
+
+
+static offset_int
+get_offset_bits (tree field)
+{
+ offset_int field_offset = wi::to_offset (DECL_FIELD_OFFSET (field));
+ offset_int field_bit_offset = wi::to_offset (DECL_FIELD_BIT_OFFSET (field));
+ unsigned long offset_align = DECL_OFFSET_ALIGN (field);
+
+ return field_offset * offset_align + field_bit_offset;
+}
+
+
+static bool
+check_cleared_low_bits (const offset_int &val, int bitcount)
+{
+ if (bitcount == 0)
+return true;
+
+ offset_int mask = wi::mask (bitcount, false);
+ if ((val & mask) != 0)
+return false;
+
+ return true;
+}
+
+
+static bool
+right_shift_if_clear (const offset_int &val, int bitcount, offset_int *result)
+{
+ if (bitcount == 0)
+{
+ *result = val;
+ return true;
+}
+
+ if (!check_cleared_low_bits (val, bitcount))
+return false;
+
+ *result = val >> bitcount;
+ return true;
+}
+
+
+static bool
+contiguous_init_p (tree type, tree value)
+{
+ gcc_assert (TREE_CODE (value) == CONSTRUCTOR);
+ auto_vec field_offsets;
+ int count = field_count (type);
+ field_offsets.reserve (count);
+
+ tree field = TYPE_FIELDS (type);
+ offset_int expected_offset = 0;
+ while (field != NULL_TREE)
+{
+ offset_int field_offset_bits = get_offset_bits (field);
+ offset_int field_offset;
+ if (!right_shift_if_clear (field_offset_bits, 3, &field_offset))
+ return false;
+
+ offset_int type_size = wi::to_offset (TYPE_SIZE_UNIT (TREE_TYPE
(field)));
+ int align = wi::ctz (type_size);
+ if (!check_cleared_low_bits (field_offset, align))
+ return false;
+
+ if (field_offset != expected_offset)
+ return false;
+
+ expected_offset += type_size;
+ field_offsets.quick_push (field_offset);
+
+ field = DECL_CHAIN (field);
+}
+
+ auto_vec value_offsets;
+ value_offsets.reserve (count);
+
+ unsigned i;
+ tree field_init;
+ FOR_EACH_CONSTRUCTOR_ELT (CONSTRUCTOR_ELTS (value), i, field, field_init)
+{
+ if (TREE_TYPE (field) != TREE_TYPE (field_init))
+ return false;
+
+ offset_int field_offset_bits = get_offset_bits (field);
+ offset_int field_offset;
+ if (!right_shift_if_clear (field_offset_bits, 3, &field_offset))
+ return false;
+
+ value_offsets.quick_push (field_offset);
+}
+
+ value_offsets.qsort (cmp_wi);
+
+ unsigned idx = 0;
+ offset_int field_off, val_off;
+ while (field_offsets.iterate (idx, &field_off)
+&& value_offsets.iterate (idx, &val_off))
+{
+ if (val_off != field_off)
+ return false;
+
+ idx++;
+}
+
+ return true;
+}
static bool
@@ -1161,7 +1281,9 @@ init_struct (stmtblock_t *block, tree data_ref, init_kind
kind,
if (TREE_STATIC (data_ref)
|| !modifiable_p (data_ref))
DECL_INITIAL (data_ref) = value;
- else if (TREE_CODE (value) == CONSTRUCTOR)
+ else if (TREE_CODE (value) == CONSTRUCTOR
+ && !(TREE_CONSTANT (value)
+ && contiguous_init_p (type, value)))
{
unsigned i;
tree field, field_init;
[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] Sauvegarde factorisation set_descriptor_from_scalar
https://gcc.gnu.org/g:34baff548d9dc0913b69f129deb42a51686257db
commit 34baff548d9dc0913b69f129deb42a51686257db
Author: Mikael Morin
Date: Tue Feb 4 11:16:32 2025 +0100
Sauvegarde factorisation set_descriptor_from_scalar
Correction régression allocate_with_source_15.f03
Nettoyage correction
Correction régression allocate_with_mold_3
Correction allocate_with_source_16.f90
Correction régression assumed_rank_21.f90
Correction coarray_allocate_8.f08
Correction régression pr86470.f90
Correction régression dummy_3.f90
Diff:
---
gcc/fortran/trans-array.cc | 204 +++--
gcc/fortran/trans-array.h | 2 +-
gcc/fortran/trans-expr.cc | 67 +--
gcc/fortran/trans-types.cc | 47 +++
gcc/fortran/trans-types.h | 1 +
gcc/fortran/trans.h| 1 +
6 files changed, 218 insertions(+), 104 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index d6e7c9829ff2..90eafe7ffe18 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 "gimplify.h"
static bool gfc_get_array_constructor_size (mpz_t *, gfc_constructor_base);
@@ -600,7 +601,7 @@ gfc_conv_descriptor_sm_get (tree desc, tree dim)
}
-static int
+static bt
get_type_info (const bt &type)
{
switch (type)
@@ -611,11 +612,13 @@ get_type_info (const bt &type)
case BT_COMPLEX:
case BT_DERIVED:
case BT_CHARACTER:
-case BT_CLASS:
case BT_VOID:
case BT_UNSIGNED:
return type;
+case BT_CLASS:
+ return BT_DERIVED;
+
case BT_PROCEDURE:
case BT_ASSUMED:
return BT_VOID;
@@ -672,9 +675,15 @@ get_size_info (gfc_typespec &ts)
class modify_info
{
public:
+ virtual bool set_dtype () const { return is_initialization (); }
+ virtual bool use_tree_type () const { return false; }
virtual bool is_initialization () const { return false; }
virtual bool initialize_data () const { return false; }
+ virtual bool set_span () const { return false; }
+ virtual bool set_token () const { return true; }
virtual tree get_data_value () const { return NULL_TREE; }
+ virtual bt get_type_type (const gfc_typespec &) const { return BT_UNKNOWN; }
+ virtual tree get_length (gfc_typespec *ts) const { return get_size_info
(*ts); }
};
class nullification : public modify_info
@@ -698,8 +707,14 @@ class init_info : public modify_info
public:
virtual bool is_initialization () const { return true; }
virtual gfc_typespec *get_type () const { return nullptr; }
+ virtual bt get_type_type (const gfc_typespec &) const;
};
+bt
+init_info::get_type_type (const gfc_typespec & type_info) const
+{
+ return get_type_info (type_info.type);
+}
class default_init : public init_info
{
@@ -729,23 +744,103 @@ public:
virtual gfc_typespec *get_type () const { return &ts; }
};
-class scalar_value : public init_info
+
+class scalar_value : public modify_info
{
private:
- gfc_typespec &ts;
+ bool initialisation;
+ gfc_typespec *ts;
tree value;
+ bool use_tree_type_;
+ bool clear_token;
+ tree get_elt_type () const;
public:
scalar_value(gfc_typespec &arg_ts, tree arg_value)
-: ts(arg_ts), value(arg_value) { }
+: initialisation(true), ts(&arg_ts), value(arg_value), use_tree_type_
(false), clear_token(true) { }
+ scalar_value(tree arg_value)
+: initialisation(true), ts(nullptr), value(arg_value), use_tree_type_
(true), clear_token(false) { }
+ virtual bool is_initialization () const { return initialisation; }
virtual bool initialize_data () const { return true; }
- virtual tree get_data_value () const { return value; }
- virtual gfc_typespec *get_type () const { return &ts; }
+ virtual tree get_data_value () const;
+ virtual gfc_typespec *get_type () const { return ts; }
+ virtual bool set_span () const { return true; }
+ virtual bool use_tree_type () const { return use_tree_type_; }
+ virtual bool set_token () const { return clear_token; }
+ virtual bt get_type_type (const gfc_typespec &) const;
+ virtual tree get_length (gfc_typespec *ts) const;
};
+tree
+scalar_value::get_data_value () const
+{
+ if (POINTER_TYPE_P (TREE_TYPE (value)))
+return value;
+ else
+return gfc_build_addr_expr (NULL_TREE, value);
+}
+
+tree
+scalar_value::get_elt_type () const
+{
+ tree tmp = value;
+
+ if (POINTER_TYPE_P (TREE_TYPE (tmp)))
+tmp = TREE_TYPE (tmp);
+
+ tree etype = TREE_TYPE (tmp);
+
+ /* For arrays, which are not scalar coarrays. */
+ if (TREE_CODE (etype) == ARRAY_TYPE && !TYPE_STRING_FLAG (etype))
+etype = TREE_TYPE (etype);
+
+ return etype;
+}
+
+bt
+scalar_value::get_type_type (const gfc_typespec & type_info) const
+{
+ bt n;
+ if (use_tree_type ())
+{
+ tree etype = get_elt_type ();
+ gf
[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] Suppression code redondant
https://gcc.gnu.org/g:0aef3272bde76847317337411e9b7b75e74dc101
commit 0aef3272bde76847317337411e9b7b75e74dc101
Author: Mikael Morin
Date: Thu Jan 30 20:57:37 2025 +0100
Suppression code redondant
Diff:
---
gcc/fortran/trans-expr.cc | 8
1 file changed, 8 deletions(-)
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 860224066167..18d54d2a1f93 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -193,14 +193,6 @@ set_descriptor_from_scalar (stmtblock_t *block, tree desc,
tree scalar,
gfc_conv_descriptor_span_set (block, desc, integer_zero_node);
- if (CONSTANT_CLASS_P (scalar))
-{
- tree tmp;
- tmp = gfc_create_var (TREE_TYPE (scalar), "scalar");
- gfc_add_modify (block, tmp, scalar);
- scalar = tmp;
-}
-
tree tmp;
if (is_class)
tmp = gfc_class_data_get (scalar);
[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] Déplacement méthode set_descriptor_from_scalar
https://gcc.gnu.org/g:da0f06041ed11f41d66b165320f27973c71d8186
commit da0f06041ed11f41d66b165320f27973c71d8186
Author: Mikael Morin
Date: Thu Jan 30 21:07:15 2025 +0100
Déplacement méthode set_descriptor_from_scalar
Correction erreur compil'
Diff:
---
gcc/fortran/trans-array.cc | 63 +++
gcc/fortran/trans-array.h | 3 ++
gcc/fortran/trans-expr.cc | 83 +-
3 files changed, 75 insertions(+), 74 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 4d08a862c5be..a1fb41fc9354 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -1772,6 +1772,69 @@ gfc_set_descriptor_with_shape (stmtblock_t *block, tree
desc,
gfc_conv_descriptor_offset_set (block, desc, offset);
}
+/* Convert a scalar to an array descriptor. To be used for assumed-rank
+ arrays. */
+
+tree
+gfc_get_scalar_to_descriptor_type (tree scalar, symbol_attribute attr)
+{
+ enum gfc_array_kind akind;
+
+ if (attr.pointer)
+akind = GFC_ARRAY_POINTER_CONT;
+ else if (attr.allocatable)
+akind = GFC_ARRAY_ALLOCATABLE;
+ else
+akind = GFC_ARRAY_ASSUMED_SHAPE_CONT;
+
+ if (POINTER_TYPE_P (TREE_TYPE (scalar)))
+scalar = TREE_TYPE (scalar);
+ return gfc_get_array_type_bounds (TREE_TYPE (scalar), 0, 0, NULL, NULL, 1,
+ akind, !(attr.pointer || attr.target));
+}
+
+
+void
+gfc_set_descriptor_from_scalar (stmtblock_t *block, tree desc, tree scalar,
+ symbol_attribute scalar_attr, bool is_class,
+ tree cond_optional)
+{
+ tree type = gfc_get_scalar_to_descriptor_type (scalar, scalar_attr);
+ if (POINTER_TYPE_P (type))
+type = TREE_TYPE (type);
+
+ tree etype = gfc_get_element_type (type);
+ tree dtype_val;
+ if (etype == void_type_node)
+dtype_val = gfc_get_dtype_rank_type (0, TREE_TYPE (scalar));
+ else
+dtype_val = gfc_get_dtype (type);
+
+ tree dtype_ref = gfc_conv_descriptor_dtype (desc);
+ gfc_add_modify (block, dtype_ref, dtype_val);
+
+ gfc_conv_descriptor_span_set (block, desc, integer_zero_node);
+
+ tree tmp;
+ if (is_class)
+tmp = gfc_class_data_get (scalar);
+ else
+tmp = scalar;
+
+ if (!POINTER_TYPE_P (TREE_TYPE (tmp)))
+tmp = gfc_build_addr_expr (NULL_TREE, tmp);
+
+ if (cond_optional)
+{
+ tmp = build3_loc (input_location, COND_EXPR, TREE_TYPE (tmp),
+ cond_optional, tmp,
+ fold_convert (TREE_TYPE (scalar),
+ null_pointer_node));
+}
+
+ gfc_conv_descriptor_data_set (block, desc, tmp);
+}
+
/* Obtain offsets for trans-types.cc(gfc_get_array_descr_info). */
diff --git a/gcc/fortran/trans-array.h b/gcc/fortran/trans-array.h
index 296a8052dd73..691231f66903 100644
--- a/gcc/fortran/trans-array.h
+++ b/gcc/fortran/trans-array.h
@@ -147,6 +147,9 @@ void gfc_clear_descriptor (stmtblock_t *block, gfc_symbol
*, gfc_expr *, tree);
void gfc_set_scalar_descriptor (stmtblock_t *block, tree, gfc_symbol *,
gfc_expr *, tree);
void gfc_set_descriptor_with_shape (stmtblock_t *, tree, tree,
gfc_expr *, locus *);
+tree gfc_get_scalar_to_descriptor_type (tree scalar, symbol_attribute attr);
+void gfc_set_descriptor_from_scalar (stmtblock_t *, tree, tree,
+symbol_attribute, bool, tree);
/* Get a single array element. */
void gfc_conv_array_ref (gfc_se *, gfc_array_ref *, gfc_expr *, locus *);
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 18d54d2a1f93..2ece9d369d80 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -83,34 +83,12 @@ gfc_get_character_len_in_bytes (tree type)
}
-/* Convert a scalar to an array descriptor. To be used for assumed-rank
- arrays. */
-
-static tree
-get_scalar_to_descriptor_type (tree scalar, symbol_attribute attr)
-{
- enum gfc_array_kind akind;
-
- if (attr.pointer)
-akind = GFC_ARRAY_POINTER_CONT;
- else if (attr.allocatable)
-akind = GFC_ARRAY_ALLOCATABLE;
- else
-akind = GFC_ARRAY_ASSUMED_SHAPE_CONT;
-
- if (POINTER_TYPE_P (TREE_TYPE (scalar)))
-scalar = TREE_TYPE (scalar);
- return gfc_get_array_type_bounds (TREE_TYPE (scalar), 0, 0, NULL, NULL, 1,
- akind, !(attr.pointer || attr.target));
-}
-
-
tree
gfc_conv_scalar_null_to_descriptor (gfc_se *se, gfc_symbol *sym, gfc_expr
*expr, tree scalar)
{
symbol_attribute attr = sym->attr;
- tree type = get_scalar_to_descriptor_type (scalar, attr);
+ tree type = gfc_get_scalar_to_descriptor_type (scalar, attr);
tree desc = gfc_create_var (type, "desc");
DECL_ARTIFICIAL (desc) = 1;
@@ -172,55 +150,12 @@ gfc_conv_null_array_descriptor (gfc_se *se, gfc_symbol
*sym, gfc_expr *expr)
}
-void
-set_descriptor_from_scalar (stmtblock_t *block, tree desc, tree scalar,
-
[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] Factorisation set_descriptor_from_scalar conv_derived_to_class
https://gcc.gnu.org/g:c3d8cf0e081de45c9a2f5d2d80ff8675f5e4614a
commit c3d8cf0e081de45c9a2f5d2d80ff8675f5e4614a
Author: Mikael Morin
Date: Wed Jan 29 18:22:29 2025 +0100
Factorisation set_descriptor_from_scalar conv_derived_to_class
Diff:
---
gcc/fortran/trans-expr.cc | 42 +++---
1 file changed, 23 insertions(+), 19 deletions(-)
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 6afb344245f2..091e1417faed 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -174,7 +174,8 @@ gfc_conv_null_array_descriptor (gfc_se *se, gfc_symbol
*sym, gfc_expr *expr)
void
set_descriptor_from_scalar (stmtblock_t *block, tree desc, tree scalar,
- gfc_expr *scalar_expr)
+ gfc_expr *scalar_expr, bool is_class,
+ tree cond_optional)
{
tree type = get_scalar_to_descriptor_type (scalar,
gfc_expr_attr (scalar_expr));
@@ -185,9 +186,22 @@ set_descriptor_from_scalar (stmtblock_t *block, tree desc,
tree scalar,
tree dtype_ref = gfc_conv_descriptor_dtype (desc);
gfc_add_modify (block, dtype_ref, dtype_val);
- tree tmp = gfc_class_data_get (scalar);
- if (!POINTER_TYPE_P (TREE_TYPE (tmp)))
-tmp = gfc_build_addr_expr (NULL_TREE, tmp);
+ tree tmp;
+ if (is_class)
+{
+ tmp = gfc_class_data_get (scalar);
+ if (!POINTER_TYPE_P (TREE_TYPE (tmp)))
+ tmp = gfc_build_addr_expr (NULL_TREE, tmp);
+}
+ else if (cond_optional)
+{
+ tmp = build3_loc (input_location, COND_EXPR, TREE_TYPE (scalar),
+ cond_optional, scalar,
+ fold_convert (TREE_TYPE (scalar),
+ null_pointer_node));
+}
+ else
+tmp = scalar;
gfc_conv_descriptor_data_set (block, desc, tmp);
}
@@ -1067,20 +1081,9 @@ gfc_conv_derived_to_class (gfc_se *parmse, gfc_expr *e,
gfc_symbol *fsym,
/* Scalar to an assumed-rank array. */
if (fsym->ts.u.derived->components->as)
- {
- tree type;
- type = get_scalar_to_descriptor_type (parmse->expr,
- gfc_expr_attr (e));
- gfc_add_modify (&parmse->pre, gfc_conv_descriptor_dtype (ctree),
- gfc_get_dtype (type));
- if (optional)
- parmse->expr = build3_loc (input_location, COND_EXPR,
- TREE_TYPE (parmse->expr),
- cond_optional, parmse->expr,
- fold_convert (TREE_TYPE
(parmse->expr),
-null_pointer_node));
- gfc_conv_descriptor_data_set (&parmse->pre, ctree, parmse->expr);
- }
+ set_descriptor_from_scalar (&parmse->pre, ctree,
+ parmse->expr, e, false,
+ cond_optional);
else
{
tmp = fold_convert (TREE_TYPE (ctree), parmse->expr);
@@ -1455,7 +1458,8 @@ gfc_conv_class_to_class (gfc_se *parmse, gfc_expr *e,
gfc_typespec class_ts,
&& e->rank != class_ts.u.derived->components->as->rank)
{
if (e->rank == 0)
- set_descriptor_from_scalar (&block, ctree, parmse->expr, e);
+ set_descriptor_from_scalar (&block, ctree, parmse->expr, e,
+ true, NULL_TREE);
else
gfc_class_array_data_assign (&block, ctree, parmse->expr, false);
}
[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] Séparation motifs dump assumed_rank_12.f90
https://gcc.gnu.org/g:cd99fadb64da650e93e666dbf2eb7c4b15a6dc5b
commit cd99fadb64da650e93e666dbf2eb7c4b15a6dc5b
Author: Mikael Morin
Date: Wed Feb 5 11:57:09 2025 +0100
Séparation motifs dump assumed_rank_12.f90
Diff:
---
gcc/testsuite/gfortran.dg/assumed_rank_12.f90 | 6 +-
1 file changed, 5 insertions(+), 1 deletion(-)
diff --git a/gcc/testsuite/gfortran.dg/assumed_rank_12.f90
b/gcc/testsuite/gfortran.dg/assumed_rank_12.f90
index 873498f82d76..cacfb7ed52af 100644
--- a/gcc/testsuite/gfortran.dg/assumed_rank_12.f90
+++ b/gcc/testsuite/gfortran.dg/assumed_rank_12.f90
@@ -16,5 +16,9 @@ function f() result(res)
end function f
end
-! { dg-final { scan-tree-dump " = f \\(\\);.*desc.0.dtype = .*;.*desc.0.data =
.void .. D.*;.*sub \\(&desc.0\\);.*D.*= .integer.kind=4. .. desc.0.data;"
"original" } }
+! { dg-final { scan-tree-dump " = f \\(\\);" "original" } }
+! { dg-final { scan-tree-dump "desc.0.dtype = .*;" "original" } }
+! { dg-final { scan-tree-dump "desc.0.data = .void .. D.*;" "original" } }
+! { dg-final { scan-tree-dump "sub \\(&desc.0\\);" "original" } }
+! { dg-final { scan-tree-dump "D.*= .integer.kind=4. .. desc.0.data;"
"original" } }
[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] Déplacement gfc_set_gfc_from_cfi
https://gcc.gnu.org/g:47b6338824d5cf0658bd91e24bd956dcf2bfaca3
commit 47b6338824d5cf0658bd91e24bd956dcf2bfaca3
Author: Mikael Morin
Date: Thu Jan 30 21:27:40 2025 +0100
Déplacement gfc_set_gfc_from_cfi
Correction compil'
Diff:
---
gcc/fortran/trans-array.cc | 258 +
gcc/fortran/trans-array.h | 3 +
gcc/fortran/trans-expr.cc | 218 --
gcc/fortran/trans.h| 3 -
4 files changed, 241 insertions(+), 241 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 455c9bcd76cc..d6e7c9829ff2 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -1466,6 +1466,26 @@ gfc_conv_shift_descriptor_subarray (stmtblock_t *block,
tree desc,
}
+int
+gfc_descriptor_rank (tree descriptor)
+{
+ if (TREE_TYPE (descriptor) != NULL_TREE)
+return GFC_TYPE_ARRAY_RANK (TREE_TYPE (descriptor));
+
+ tree dim = gfc_get_descriptor_dimension (descriptor);
+ tree dim_type = TREE_TYPE (dim);
+ gcc_assert (TREE_CODE (dim_type) == ARRAY_TYPE);
+ tree idx_type = TYPE_DOMAIN (dim_type);
+ gcc_assert (TREE_CODE (idx_type) == INTEGER_TYPE);
+ gcc_assert (integer_zerop (TYPE_MIN_VALUE (idx_type)));
+ tree idx_max = TYPE_MAX_VALUE (idx_type);
+ if (idx_max == NULL_TREE)
+return GFC_MAX_DIMENSIONS;
+ wide_int max = wi::to_wide (idx_max);
+ return max.to_shwi () + 1;
+}
+
+
void
gfc_conv_remap_descriptor (stmtblock_t *block, tree dest, tree src,
int src_rank, const gfc_array_spec &as)
@@ -1835,26 +1855,6 @@ gfc_set_descriptor_from_scalar (stmtblock_t *block, tree
desc, tree scalar,
gfc_conv_descriptor_data_set (block, desc, tmp);
}
-int
-gfc_descriptor_rank (tree descriptor)
-{
- if (TREE_TYPE (descriptor) != NULL_TREE)
-return GFC_TYPE_ARRAY_RANK (TREE_TYPE (descriptor));
-
- tree dim = gfc_get_descriptor_dimension (descriptor);
- tree dim_type = TREE_TYPE (dim);
- gcc_assert (TREE_CODE (dim_type) == ARRAY_TYPE);
- tree idx_type = TYPE_DOMAIN (dim_type);
- gcc_assert (TREE_CODE (idx_type) == INTEGER_TYPE);
- gcc_assert (integer_zerop (TYPE_MIN_VALUE (idx_type)));
- tree idx_max = TYPE_MAX_VALUE (idx_type);
- if (idx_max == NULL_TREE)
-return GFC_MAX_DIMENSIONS;
- wide_int max = wi::to_wide (idx_max);
- return max.to_shwi () + 1;
-}
-
-
void
gfc_copy_sequence_descriptor (stmtblock_t &block, tree lhs_desc, tree rhs_desc,
bool assumed_rank_lhs)
@@ -1899,6 +1899,224 @@ gfc_copy_sequence_descriptor (stmtblock_t &block, tree
lhs_desc, tree rhs_desc,
}
+void
+gfc_set_gfc_from_cfi (stmtblock_t *unconditional_block,
+ stmtblock_t *conditional_block, tree gfc, tree cfi,
+ tree rank, gfc_symbol *gfc_sym,
+ bool init_static, bool contiguous_gfc, bool
contiguous_cfi)
+{
+ tree tmp = gfc_get_cfi_desc_base_addr (cfi);
+ gfc_conv_descriptor_data_set (unconditional_block, gfc, tmp);
+
+ if (init_static)
+{
+ /* gfc->dtype = ... (from declaration, not from cfi). */
+ tree etype = gfc_get_element_type (TREE_TYPE (gfc));
+ gfc_add_modify (unconditional_block, gfc_conv_descriptor_dtype (gfc),
+ gfc_get_dtype_rank_type (gfc_sym->as->rank, etype));
+
+ if (gfc_sym->as->type == AS_ASSUMED_RANK)
+ gfc_add_modify (unconditional_block,
+ gfc_conv_descriptor_rank (gfc), rank);
+}
+
+ if (gfc_sym && gfc_sym->ts.type == BT_ASSUMED)
+{
+ /* For type(*), take elem_len + dtype.type from the actual argument. */
+ gfc_add_modify (unconditional_block, gfc_conv_descriptor_elem_len (gfc),
+ gfc_get_cfi_desc_elem_len (cfi));
+ tree cond;
+ tree ctype = gfc_get_cfi_desc_type (cfi);
+ ctype = fold_build2_loc (input_location, BIT_AND_EXPR, TREE_TYPE (ctype),
+ ctype, build_int_cst (TREE_TYPE (ctype),
+CFI_type_mask));
+ tree type = gfc_conv_descriptor_type (gfc);
+
+ /* if (CFI_type_cptr) BT_VOID else BT_UNKNOWN */
+ /* Note: BT_VOID is could also be CFI_type_funcptr, but assume c_ptr. */
+ cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node,
ctype,
+ build_int_cst (TREE_TYPE (ctype), CFI_type_cptr));
+ tmp = fold_build2_loc (input_location, MODIFY_EXPR, void_type_node, type,
+build_int_cst (TREE_TYPE (type), BT_VOID));
+ tree tmp2 = fold_build2_loc (input_location, MODIFY_EXPR, void_type_node,
+ type,
+ build_int_cst (TREE_TYPE (type),
BT_UNKNOWN));
+ tmp2 = fold_build3_loc (input_location, COND_EXPR, void_type_node, cond,
+ tmp, tmp2);
+ /* if (CFI_type_struct) BT_DERIVED else < tmp2 > */
+ cond = fold_build2_loc (input_location, EQ_
[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] Renseignement token par gfc_set_descriptor_from_scalar.
https://gcc.gnu.org/g:96c395b57efb83588e592fca055aac91794c0919
commit 96c395b57efb83588e592fca055aac91794c0919
Author: Mikael Morin
Date: Wed Feb 5 15:12:25 2025 +0100
Renseignement token par gfc_set_descriptor_from_scalar.
Diff:
---
gcc/fortran/trans-array.cc | 27 ---
gcc/fortran/trans-array.h | 2 +-
gcc/fortran/trans-expr.cc | 15 +++
3 files changed, 32 insertions(+), 12 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 531281049646..c09b9bdab155 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -682,6 +682,7 @@ public:
virtual bool set_span () const { return false; }
virtual bool set_token () const { return true; }
virtual tree get_data_value () const { return NULL_TREE; }
+ virtual tree get_caf_token () const { return null_pointer_node; }
virtual bt get_type_type (const gfc_typespec &) const { return BT_UNKNOWN; }
virtual tree get_length (gfc_typespec *ts) const { return get_size_info
(*ts); }
};
@@ -751,22 +752,24 @@ private:
bool initialisation;
gfc_typespec *ts;
tree value;
+ tree caf_token;
bool use_tree_type_;
bool clear_token;
tree get_elt_type () const;
public:
scalar_value(gfc_typespec &arg_ts, tree arg_value)
-: initialisation(true), ts(&arg_ts), value(arg_value), use_tree_type_
(false), clear_token(true) { }
- scalar_value(tree arg_value)
-: initialisation(true), ts(nullptr), value(arg_value), use_tree_type_
(true), clear_token(false) { }
+: initialisation(true), ts(&arg_ts), value(arg_value), caf_token
(NULL_TREE), use_tree_type_ (false), clear_token(true) { }
+ scalar_value(tree arg_value, tree arg_caf_token)
+: initialisation(true), ts(nullptr), value(arg_value), caf_token
(arg_caf_token), use_tree_type_ (true), clear_token(false) { }
virtual bool is_initialization () const { return initialisation; }
virtual bool initialize_data () const { return true; }
virtual tree get_data_value () const;
virtual gfc_typespec *get_type () const { return ts; }
virtual bool set_span () const { return true; }
virtual bool use_tree_type () const { return use_tree_type_; }
- virtual bool set_token () const { return clear_token; }
+ virtual bool set_token () const { return clear_token || caf_token !=
NULL_TREE; }
+ virtual tree get_caf_token () const;
virtual bt get_type_type (const gfc_typespec &) const;
virtual tree get_length (gfc_typespec *ts) const;
};
@@ -838,6 +841,16 @@ scalar_value::get_length (gfc_typespec * type_info) const
return size;
}
+tree
+scalar_value::get_caf_token () const
+{
+ if (set_token ()
+ && caf_token != NULL_TREE)
+return caf_token;
+ else
+return modify_info::get_caf_token ();
+}
+
static tree
build_dtype (gfc_typespec *ts, int rank, const symbol_attribute &,
@@ -933,7 +946,7 @@ get_descriptor_init (tree type, gfc_typespec *ts, int rank,
tree token_field = gfc_advance_chain (fields,
CAF_TOKEN_FIELD - (!dim_present));
tree token_value = fold_convert (TREE_TYPE (token_field),
- null_pointer_node);
+ init.get_caf_token ());
CONSTRUCTOR_APPEND_ELT (v, token_field, token_value);
}
@@ -1430,11 +1443,11 @@ gfc_set_scalar_descriptor (stmtblock_t *block, tree
descriptor,
void
gfc_set_descriptor_from_scalar (stmtblock_t *block, tree desc, tree scalar,
- symbol_attribute *attr)
+ symbol_attribute *attr, tree caf_token)
{
init_struct (block, desc,
get_descriptor_init (TREE_TYPE (desc), nullptr, 0, attr,
- scalar_value (scalar)));
+ scalar_value (scalar, caf_token)));
}
diff --git a/gcc/fortran/trans-array.h b/gcc/fortran/trans-array.h
index 97cf7f8cb41f..2dad79aa9993 100644
--- a/gcc/fortran/trans-array.h
+++ b/gcc/fortran/trans-array.h
@@ -149,7 +149,7 @@ void gfc_set_descriptor_with_shape (stmtblock_t *, tree,
tree,
gfc_expr *, locus *);
tree gfc_get_scalar_to_descriptor_type (tree scalar, symbol_attribute attr);
void gfc_set_descriptor_from_scalar (stmtblock_t *, tree, tree,
-symbol_attribute *);
+symbol_attribute *, tree = NULL_TREE);
void gfc_copy_sequence_descriptor (stmtblock_t &, tree, tree, bool);
void gfc_set_gfc_from_cfi (stmtblock_t *, stmtblock_t *, tree, tree, tree,
gfc_symbol *, bool, bool, bool);
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 39bd7178c3c0..13a1ec1e8fe3 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -883,14 +883,20 @@ gfc_conv_derived_to_class (gfc_se *parmse, gfc_expr *e,
gfc_symbol *fsym,
/* Now set the data field. */
ctree = gfc_
[gcc r15-7383] tree-optimization/118749 - bogus alignment peeling causes misaligned access
https://gcc.gnu.org/g:927e10bfce569947354cdd6b35c29b74e25c7816
commit r15-7383-g927e10bfce569947354cdd6b35c29b74e25c7816
Author: Richard Biener
Date: Wed Feb 5 10:28:25 2025 +0100
tree-optimization/118749 - bogus alignment peeling causes misaligned access
The vectorizer thinks it can align a vector access to 16 bytes when
using a vectorization factor of 8 and 1 byte elements. That of
course does not work for the 2nd vector iteration. Apparently we
lack a guard against such nonsense.
PR tree-optimization/118749
* tree-vect-data-refs.cc (vector_alignment_reachable_p): Pass
in the vectorization factor, when that cannot maintain
the DRs target alignment do not claim we can reach that
by peeling.
* gcc.dg/vect/pr118749.c: New testcase.
Diff:
---
gcc/testsuite/gcc.dg/vect/pr118749.c | 41
gcc/tree-vect-data-refs.cc | 24 ++---
2 files changed, 57 insertions(+), 8 deletions(-)
diff --git a/gcc/testsuite/gcc.dg/vect/pr118749.c
b/gcc/testsuite/gcc.dg/vect/pr118749.c
new file mode 100644
index ..eed8bd0d7e0c
--- /dev/null
+++ b/gcc/testsuite/gcc.dg/vect/pr118749.c
@@ -0,0 +1,41 @@
+/* { dg-additional-options "-mtune=pentium4" { target ia32 } } */
+
+#include "tree-vect.h"
+
+typedef unsigned char FcChar8;
+typedef unsigned short FcChar16;
+typedef unsigned int FcChar32;
+typedef int FcBool;
+
+#define FcFalse 0
+#define FcTrue 1
+#define FcDontCare 2
+
+__attribute__((noipa))
+static FcBool
+FcLooksLikeSJIS (FcChar8 *string, int len)
+{
+int nhigh = 0, nlow = 0;
+
+while (len-- > 0)
+{
+if (*string++ & 0x80) nhigh++;
+else nlow++;
+}
+/*
+ * Heuristic -- if more than 1/3 of the bytes have the high-bit set,
+ * this is likely to be SJIS and not ROMAN
+ */
+if (nhigh * 2 > nlow)
+return FcTrue;
+return FcFalse;
+}
+
+int main()
+{
+ check_vect ();
+ unsigned char* s = "DejaVuMathTeXGyre-Regulardtd!";
+ if (FcLooksLikeSJIS(s, 29))
+abort ();
+ return 0;
+}
diff --git a/gcc/tree-vect-data-refs.cc b/gcc/tree-vect-data-refs.cc
index 6eda40267bd1..6d5854ac7c7a 100644
--- a/gcc/tree-vect-data-refs.cc
+++ b/gcc/tree-vect-data-refs.cc
@@ -1722,31 +1722,37 @@ not_size_aligned (tree exp)
a few loop iterations. Return false otherwise. */
static bool
-vector_alignment_reachable_p (dr_vec_info *dr_info)
+vector_alignment_reachable_p (dr_vec_info *dr_info, poly_uint64 vf)
{
stmt_vec_info stmt_info = dr_info->stmt;
tree vectype = STMT_VINFO_VECTYPE (stmt_info);
+ poly_uint64 nelements = TYPE_VECTOR_SUBPARTS (vectype);
+ poly_uint64 vector_size = GET_MODE_SIZE (TYPE_MODE (vectype));
+ unsigned elem_size = vector_element_size (vector_size, nelements);
+ unsigned group_size = 1;
if (STMT_VINFO_GROUPED_ACCESS (stmt_info))
{
/* For interleaved access we peel only if number of iterations in
the prolog loop ({VF - misalignment}), is a multiple of the
number of the interleaved accesses. */
- int elem_size, mis_in_elements;
/* FORNOW: handle only known alignment. */
if (!known_alignment_for_access_p (dr_info, vectype))
return false;
- poly_uint64 nelements = TYPE_VECTOR_SUBPARTS (vectype);
- poly_uint64 vector_size = GET_MODE_SIZE (TYPE_MODE (vectype));
- elem_size = vector_element_size (vector_size, nelements);
- mis_in_elements = dr_misalignment (dr_info, vectype) / elem_size;
-
+ unsigned mis_in_elements = dr_misalignment (dr_info, vectype) /
elem_size;
if (!multiple_p (nelements - mis_in_elements, DR_GROUP_SIZE (stmt_info)))
return false;
+
+ group_size = DR_GROUP_SIZE (DR_GROUP_FIRST_ELEMENT (stmt_info));
}
+ /* If the vectorization factor does not guarantee DR advancement of
+ a multiple of the target alignment no peeling will help. */
+ if (!multiple_p (elem_size * group_size * vf, dr_target_alignment (dr_info)))
+return false;
+
/* If misalignment is known at the compile time then allow peeling
only if natural alignment is reachable through peeling. */
if (known_alignment_for_access_p (dr_info, vectype)
@@ -2346,7 +2352,9 @@ vect_enhance_data_refs_alignment (loop_vec_info
loop_vinfo)
stmt_vec_info stmt_info = dr_info->stmt;
tree vectype = STMT_VINFO_VECTYPE (stmt_info);
- do_peeling = vector_alignment_reachable_p (dr_info);
+ do_peeling
+ = vector_alignment_reachable_p (dr_info,
+ LOOP_VINFO_VECT_FACTOR (loop_vinfo));
if (do_peeling)
{
if (known_alignment_for_access_p (dr_info, vectype))
[gcc r15-7384] rtl-optimization/117922 - disable fold-mem-offsets for highly connected CFG
https://gcc.gnu.org/g:677122c9df1b55a791a54426269f7a8ce794f947
commit r15-7384-g677122c9df1b55a791a54426269f7a8ce794f947
Author: Richard Biener
Date: Wed Feb 5 13:17:47 2025 +0100
rtl-optimization/117922 - disable fold-mem-offsets for highly connected CFG
The PR shows fold-mem-offsets taking ages and a lot of memory computing
DU/UD chains as that requires the RD problem. The issue is not so much
the memory required for the pruned sets but the high CFG connectivity
(and that the CFG is cyclic) which makes solving the dataflow problem
expensive.
The following adds the same limit as the one imposed by GCSE and CPROP.
PR rtl-optimization/117922
* fold-mem-offsets.cc (pass_fold_mem_offsets::execute):
Do nothing for a highly connected CFG.
Diff:
---
gcc/fold-mem-offsets.cc | 18 ++
1 file changed, 18 insertions(+)
diff --git a/gcc/fold-mem-offsets.cc b/gcc/fold-mem-offsets.cc
index a816006e2078..c1c94472a071 100644
--- a/gcc/fold-mem-offsets.cc
+++ b/gcc/fold-mem-offsets.cc
@@ -35,6 +35,7 @@ along with GCC; see the file COPYING3. If not see
#include "df.h"
#include "tree-pass.h"
#include "cfgrtl.h"
+#include "diagnostic-core.h"
/* This pass tries to optimize memory offset calculations by moving constants
from add instructions to the memory instructions (loads / stores).
@@ -841,6 +842,23 @@ do_commit_insn (rtx_insn *insn)
unsigned int
pass_fold_mem_offsets::execute (function *fn)
{
+ /* Computing UD/DU chains for flow graphs which have a high connectivity
+ will take a long time and is unlikely to be particularly useful.
+
+ In normal circumstances a cfg should have about twice as many
+ edges as blocks. But we do not want to punish small functions
+ which have a couple switch statements. Rather than simply
+ threshold the number of blocks, uses something with a more
+ graceful degradation. */
+ if (n_edges_for_fn (fn) > 2 + n_basic_blocks_for_fn (fn) * 4)
+{
+ warning (OPT_Wdisabled_optimization,
+ "fold-mem-offsets: %d basic blocks and %d edges/basic block",
+ n_basic_blocks_for_fn (cfun),
+ n_edges_for_fn (cfun) / n_basic_blocks_for_fn (cfun));
+ return 0;
+}
+
df_set_flags (DF_EQ_NOTES + DF_RD_PRUNE_DEAD_DEFS + DF_DEFER_INSN_RESCAN);
df_chain_add_problem (DF_UD_CHAIN + DF_DU_CHAIN);
df_analyze ();
[gcc(refs/users/aoliva/heads/testme)] [testsuite] [sparc] select ultrasparc for fsmuld test
https://gcc.gnu.org/g:c936fd0eb997aa84412655ab2b745132311b7610
commit c936fd0eb997aa84412655ab2b745132311b7610
Author: Alexandre Oliva
Date: Thu Feb 6 05:09:09 2025 -0300
[testsuite] [sparc] select ultrasparc for fsmuld test
vis3move-3.c expects fsmuld, that is not available on all variants of
sparc. Select a cpu that supports it for the test.
Now, -mfix-ut699 irrevocbly disables fsmuld, so skip the test if the
test configuration uses that option.
for gcc/testsuite/ChangeLog
* gcc.target/sparc/vis3move-3.c: Select ultrasparc. Skip with
-mfix-ut699.
Diff:
---
gcc/testsuite/gcc.target/sparc/vis3move-3.c | 3 ++-
1 file changed, 2 insertions(+), 1 deletion(-)
diff --git a/gcc/testsuite/gcc.target/sparc/vis3move-3.c
b/gcc/testsuite/gcc.target/sparc/vis3move-3.c
index 3b2116eec0cb..f32ca918bac9 100644
--- a/gcc/testsuite/gcc.target/sparc/vis3move-3.c
+++ b/gcc/testsuite/gcc.target/sparc/vis3move-3.c
@@ -1,6 +1,7 @@
/* { dg-do compile } */
/* { dg-require-effective-target ilp32 } */
-/* { dg-options "-O1 -mvis3" } */
+/* { dg-skip-if "prevents fsmuld" { *-*-* } { "-mfix-ut699" } { "" } } */
+/* { dg-options "-O1 -mvis3 -mcpu=ultrasparc" } */
float fnegs (float a)
{
[gcc/aoliva/heads/testme] (21 commits) [testsuite] [sparc] select ultrasparc for fsmuld test
The branch 'aoliva/heads/testme' was updated to point to:
c936fd0eb997... [testsuite] [sparc] select ultrasparc for fsmuld test
It previously pointed to:
06269f83b828... [testsuite] require -Ofast for vect-ifcvt-18 even without a
Diff:
!!! WARNING: THE FOLLOWING COMMITS ARE NO LONGER ACCESSIBLE (LOST):
---
06269f8... [testsuite] require -Ofast for vect-ifcvt-18 even without a
eb3bc62... [testsuite] require profiling support [PR113689]
Summary of changes (added commits):
---
c936fd0... [testsuite] [sparc] select ultrasparc for fsmuld test
8da3444... [testsuite] [sparc] skip sparc-ret-1 with -mfix-ut699
20c5853... [testsuite] [sparc] use -mtune in alignment tuning test
144fef6... [testsuite] tolerate later success [PR108357]
ea14d0a... [testsuite] [sparc] skip tls tests if emulated
dd5978b... [testsuite] require profiling support [PR113689] (*)
2ca288d... [testsuite] require -Ofast for vect-ifcvt-18 even without a (*)
1e819a9... AVR: Provide built-ins for strlen where the string lives in (*)
cde452e... AVR: Only provide a built-in when it is available. (*)
4e6fd85... OpenMP: Update documentation of metadirective implementatio (*)
8fbccdb... OpenMP: Fortran support for metadirectives and dynamic sele (*)
6a6df26... s390: Fix up *vec_cmpgt{,u}_nocc_emu splitters (*)
ba6cac8... c++: remove LAMBDA_EXPR_CAPTURES_THIS_P (*)
c5667a1... c++: Update const_decl handling after r15-7259 [PR118673]. (*)
9ba2de7... middle-end/118695 - missed misalign handling in MEM_REF exp (*)
34d8c84... libstdc++: Use safe integer comparisons in std::latch [PR98 (*)
bea86e8... OpenMP: append_args clause fixes + Fortran support (*)
6b56e64... middle-end/118692 - ICE with out-of-bound ref expansion (*)
d1c7837... tree-optimization/114052 - consider infinite sub-loops when (*)
f559ac8... pair-fusion: Check for invalid use arrays [PR118320] (*)
15dba7d... [PR testsuite/116860] Testsuite adjustment for recently add (*)
(*) This commit already exists in another branch.
Because the reference `refs/users/aoliva/heads/testme' matches
your hooks.email-new-commits-only configuration,
no separate email is sent for this commit.
[gcc/aoliva/heads/testbase] (16 commits) [testsuite] require profiling support [PR113689]
The branch 'aoliva/heads/testbase' was updated to point to:
dd5978b2f008... [testsuite] require profiling support [PR113689]
It previously pointed to:
0942ee328dd0... Daily bump.
Diff:
Summary of changes (added commits):
---
dd5978b... [testsuite] require profiling support [PR113689] (*)
2ca288d... [testsuite] require -Ofast for vect-ifcvt-18 even without a (*)
1e819a9... AVR: Provide built-ins for strlen where the string lives in (*)
cde452e... AVR: Only provide a built-in when it is available. (*)
4e6fd85... OpenMP: Update documentation of metadirective implementatio (*)
8fbccdb... OpenMP: Fortran support for metadirectives and dynamic sele (*)
6a6df26... s390: Fix up *vec_cmpgt{,u}_nocc_emu splitters (*)
ba6cac8... c++: remove LAMBDA_EXPR_CAPTURES_THIS_P (*)
c5667a1... c++: Update const_decl handling after r15-7259 [PR118673]. (*)
9ba2de7... middle-end/118695 - missed misalign handling in MEM_REF exp (*)
34d8c84... libstdc++: Use safe integer comparisons in std::latch [PR98 (*)
bea86e8... OpenMP: append_args clause fixes + Fortran support (*)
6b56e64... middle-end/118692 - ICE with out-of-bound ref expansion (*)
d1c7837... tree-optimization/114052 - consider infinite sub-loops when (*)
f559ac8... pair-fusion: Check for invalid use arrays [PR118320] (*)
15dba7d... [PR testsuite/116860] Testsuite adjustment for recently add (*)
(*) This commit already exists in another branch.
Because the reference `refs/users/aoliva/heads/testbase' matches
your hooks.email-new-commits-only configuration,
no separate email is sent for this commit.
[gcc(refs/users/aoliva/heads/testme)] [testsuite] [sparc] skip tls tests if emulated
https://gcc.gnu.org/g:ea14d0a16f44967470cd2cc87d76eaa635191e79
commit ea14d0a16f44967470cd2cc87d76eaa635191e79
Author: Alexandre Oliva
Date: Thu Feb 6 05:07:44 2025 -0300
[testsuite] [sparc] skip tls tests if emulated
A number of tls tests expect TLS-specific relocations, that are not
present when tls is emulated, as on e.g. leon3-elf. Skip the tests
when tls is emulated.
for gcc/testsuite/ChangeLog
* gcc.target/sparc/tls-ld-int16.c: Skip when tls is emulated.
* gcc.target/sparc/tls-ld-int32.c: Likewise.
* gcc.target/sparc/tls-ld-int8.c: Likewise.
* gcc.target/sparc/tls-ld-uint16.c: Likewise.
* gcc.target/sparc/tls-ld-uint32.c: Likewise.
* gcc.target/sparc/tls-ld-uint8.c: Likewise.
Diff:
---
gcc/testsuite/gcc.target/sparc/tls-ld-int16.c | 1 +
gcc/testsuite/gcc.target/sparc/tls-ld-int32.c | 1 +
gcc/testsuite/gcc.target/sparc/tls-ld-int8.c | 1 +
gcc/testsuite/gcc.target/sparc/tls-ld-uint16.c | 1 +
gcc/testsuite/gcc.target/sparc/tls-ld-uint32.c | 1 +
gcc/testsuite/gcc.target/sparc/tls-ld-uint8.c | 1 +
6 files changed, 6 insertions(+)
diff --git a/gcc/testsuite/gcc.target/sparc/tls-ld-int16.c
b/gcc/testsuite/gcc.target/sparc/tls-ld-int16.c
index d3d28086156e..de4ce4034c6d 100644
--- a/gcc/testsuite/gcc.target/sparc/tls-ld-int16.c
+++ b/gcc/testsuite/gcc.target/sparc/tls-ld-int16.c
@@ -1,6 +1,7 @@
/* { dg-do compile } */
/* { dg-options "-O2" }
/* { dg-add-options tls } */
+/* { dg-skip-if "native tls expected" { tls_emulated } } */
#include
diff --git a/gcc/testsuite/gcc.target/sparc/tls-ld-int32.c
b/gcc/testsuite/gcc.target/sparc/tls-ld-int32.c
index cf18147ef727..5604c24151ac 100644
--- a/gcc/testsuite/gcc.target/sparc/tls-ld-int32.c
+++ b/gcc/testsuite/gcc.target/sparc/tls-ld-int32.c
@@ -1,6 +1,7 @@
/* { dg-do compile } */
/* { dg-options "-O2" }
/* { dg-add-options tls } */
+/* { dg-skip-if "native tls expected" { tls_emulated } } */
#include
diff --git a/gcc/testsuite/gcc.target/sparc/tls-ld-int8.c
b/gcc/testsuite/gcc.target/sparc/tls-ld-int8.c
index a07cffc37f8c..17eb32ea2a10 100644
--- a/gcc/testsuite/gcc.target/sparc/tls-ld-int8.c
+++ b/gcc/testsuite/gcc.target/sparc/tls-ld-int8.c
@@ -1,6 +1,7 @@
/* { dg-do compile } */
/* { dg-options "-O2" }
/* { dg-add-options tls } */
+/* { dg-skip-if "native tls expected" { tls_emulated } } */
#include
diff --git a/gcc/testsuite/gcc.target/sparc/tls-ld-uint16.c
b/gcc/testsuite/gcc.target/sparc/tls-ld-uint16.c
index 41ee687b28c5..81990a7bf3ca 100644
--- a/gcc/testsuite/gcc.target/sparc/tls-ld-uint16.c
+++ b/gcc/testsuite/gcc.target/sparc/tls-ld-uint16.c
@@ -1,6 +1,7 @@
/* { dg-do compile } */
/* { dg-options "-O2" }
/* { dg-add-options tls } */
+/* { dg-skip-if "native tls expected" { tls_emulated } } */
#include
diff --git a/gcc/testsuite/gcc.target/sparc/tls-ld-uint32.c
b/gcc/testsuite/gcc.target/sparc/tls-ld-uint32.c
index 9c7915372b9e..60524ba87cf6 100644
--- a/gcc/testsuite/gcc.target/sparc/tls-ld-uint32.c
+++ b/gcc/testsuite/gcc.target/sparc/tls-ld-uint32.c
@@ -1,6 +1,7 @@
/* { dg-do compile } */
/* { dg-options "-O2" }
/* { dg-add-options tls } */
+/* { dg-skip-if "native tls expected" { tls_emulated } } */
#include
diff --git a/gcc/testsuite/gcc.target/sparc/tls-ld-uint8.c
b/gcc/testsuite/gcc.target/sparc/tls-ld-uint8.c
index 0dcff66eb15e..7a7492197f95 100644
--- a/gcc/testsuite/gcc.target/sparc/tls-ld-uint8.c
+++ b/gcc/testsuite/gcc.target/sparc/tls-ld-uint8.c
@@ -1,6 +1,7 @@
/* { dg-do compile } */
/* { dg-options "-O2" }
/* { dg-add-options tls } */
+/* { dg-skip-if "native tls expected" { tls_emulated } } */
#include
[gcc(refs/users/aoliva/heads/testme)] [testsuite] [sparc] skip sparc-ret-1 with -mfix-ut699
https://gcc.gnu.org/g:8da34442f6a6d432e52024afc93d3e8e586412f8
commit 8da34442f6a6d432e52024afc93d3e8e586412f8
Author: Alexandre Oliva
Date: Thu Feb 6 05:08:52 2025 -0300
[testsuite] [sparc] skip sparc-ret-1 with -mfix-ut699
Option -mfix-ut699 changes the set of instructions that can be placed
in the delay slot, preventing the expected insn placement. Skip the
test if the option is present.
for gcc/testsuite/ChangeLog
* gcc.target/sparc/sparc-ret-1.c: Skip on -mfix-ut699.
Diff:
---
gcc/testsuite/gcc.target/sparc/sparc-ret-1.c | 1 +
1 file changed, 1 insertion(+)
diff --git a/gcc/testsuite/gcc.target/sparc/sparc-ret-1.c
b/gcc/testsuite/gcc.target/sparc/sparc-ret-1.c
index 808e8a98f0e8..ef459c5016e9 100644
--- a/gcc/testsuite/gcc.target/sparc/sparc-ret-1.c
+++ b/gcc/testsuite/gcc.target/sparc/sparc-ret-1.c
@@ -1,5 +1,6 @@
/* { dg-do compile } */
/* { dg-skip-if "no register windows" { *-*-* } { "-mflat" } { "" } } */
+/* { dg-skip-if "prevents expected asm" { *-*-* } { "-mfix-ut699" } { "" } } */
/* { dg-require-effective-target ilp32 } */
/* { dg-options "-mcpu=ultrasparc -O" } */
[gcc(refs/users/aoliva/heads/testme)] [testsuite] [sparc] use -mtune in alignment tuning test
https://gcc.gnu.org/g:20c5853d17c25cf7df7333ffc9e36097a097f1de
commit 20c5853d17c25cf7df7333ffc9e36097a097f1de
Author: Alexandre Oliva
Date: Thu Feb 6 05:08:28 2025 -0300
[testsuite] [sparc] use -mtune in alignment tuning test
If -mcpu=leon3 is present in the command line for a test run,
overriding it with -mcpu=niagara7 is not enough to override the tuning
for leon3 selected by the previous -mcpu option.
niagara7-align.c tests for niagara7 alignment tuning, so use -mtune
rather than -mcpu.
for gcc/testsuite/ChangeLog
* gcc.target/sparc/niagara7-align.c: Use -mtune.
Diff:
---
gcc/testsuite/gcc.target/sparc/niagara7-align.c | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/gcc/testsuite/gcc.target/sparc/niagara7-align.c
b/gcc/testsuite/gcc.target/sparc/niagara7-align.c
index a46aac17c329..01a8cb621d5c 100644
--- a/gcc/testsuite/gcc.target/sparc/niagara7-align.c
+++ b/gcc/testsuite/gcc.target/sparc/niagara7-align.c
@@ -1,4 +1,4 @@
/* { dg-do compile } */
-/* { dg-options "-falign-functions -mcpu=niagara7" } */
+/* { dg-options "-falign-functions -mtune=niagara7" } */
/* { dg-final { scan-assembler "\.align 64" } } */
void foo(void) {}
[gcc(refs/users/aoliva/heads/testme)] [testsuite] tolerate later success [PR108357]
https://gcc.gnu.org/g:144fef602ecceb995d5d65b7e549b76358cab534
commit 144fef602ecceb995d5d65b7e549b76358cab534
Author: Alexandre Oliva
Date: Thu Feb 6 05:08:07 2025 -0300
[testsuite] tolerate later success [PR108357]
On leon3-elf and presumably on other targets, the test fails due to
differences in calling conventions and other reasons, that add extra
gimple stmts that prevent the expected optimization at the expected
point. The optimization takes place anyway, just a little later, so
tolerate that.
for gcc/testsuite/ChangeLog
PR tree-optimization/108357
* gcc.dg/tree-ssa/pr108357.c: Tolerate later optimization.
Diff:
---
gcc/testsuite/gcc.dg/tree-ssa/pr108357.c | 7 +--
1 file changed, 5 insertions(+), 2 deletions(-)
diff --git a/gcc/testsuite/gcc.dg/tree-ssa/pr108357.c
b/gcc/testsuite/gcc.dg/tree-ssa/pr108357.c
index 44c457b7a977..7dff235f8927 100644
--- a/gcc/testsuite/gcc.dg/tree-ssa/pr108357.c
+++ b/gcc/testsuite/gcc.dg/tree-ssa/pr108357.c
@@ -1,5 +1,5 @@
/* { dg-do compile } */
-/* { dg-options "-O2 -fdump-tree-threadfull1" } */
+/* { dg-options "-O2 -fdump-tree-optimized" } */
static char b;
static unsigned c;
@@ -19,4 +19,7 @@ int main()
f(g);
}
-/* { dg-final { scan-tree-dump-not "foo" "threadfull1" } } */
+/* We expect threadfull1 to eliminate the call to foo(), but not all targets
+ manage that at that point. Calling conventions (mandatory promotion) play a
+ role, but there's more than that. */
+/* { dg-final { scan-tree-dump-not "foo" "optimized" } } */
[gcc r15-7385] vect: Move induction IV increments [PR110449]
https://gcc.gnu.org/g:7eb260c8a472568912c1e0b83fb402d22977281e
commit r15-7385-g7eb260c8a472568912c1e0b83fb402d22977281e
Author: Richard Sandiford
Date: Thu Feb 6 10:30:53 2025 +
vect: Move induction IV increments [PR110449]
In this PR, we used to generate:
.L6:
mov v30.16b, v31.16b
faddv31.4s, v31.4s, v27.4s
faddv29.4s, v30.4s, v28.4s
stp q30, q29, [x0]
add x0, x0, 32
cmp x1, x0
bne .L6
for an unrolled induction in:
for (int i = 0; i < 1024; i++)
{
arr[i] = freq;
freq += step;
}
with the problem being the unnecessary MOV.
The main induction IV was incremented by VF * step == 2 * nunits * step,
and then nunits * step was added for the second store to arr.
The original patch for the PR (r14-2367-g224fd59b2dc8) avoided the MOV
by incrementing the IV by nunits * step twice. The problem with that
approach is that it doubles the loop-carried latency. This change was
deliberately not preserved when moving from loop-vect to SLP and so
the test started failing again after r15-3509-gd34cda720988.
I think the main problem is that we put the IV increment in the wrong
place. Normal IVs created by create_iv are placed before the exit
condition where possible, but vectorizable_induction instead always
inserted them at the start of the loop body. The only use of the
incremented IV is by the phi node, so the effect is to make both
the old and new IV values live for the whole loop body, which is
why we need the MOV.
The simplest fix therefore seems to be to reuse the create_iv logic.
gcc/
PR tree-optimization/110449
* tree-ssa-loop-manip.h (insert_iv_increment): Declare.
* tree-ssa-loop-manip.cc (insert_iv_increment): New function,
split out from...
(create_iv): ...here and generalized to gimple_seqs.
* tree-vect-loop.cc (vectorizable_induction): Use
standard_iv_increment_position and insert_iv_increment
to insert the IV increment.
gcc/testsuite/
PR tree-optimization/110449
* gcc.target/aarch64/pr110449.c: Expect an increment by 8.0,
but test that there is no MOV.
Diff:
---
gcc/testsuite/gcc.target/aarch64/pr110449.c | 25 +++-
gcc/tree-ssa-loop-manip.cc | 62 +
gcc/tree-ssa-loop-manip.h | 1 +
gcc/tree-vect-loop.cc | 6 ++-
4 files changed, 57 insertions(+), 37 deletions(-)
diff --git a/gcc/testsuite/gcc.target/aarch64/pr110449.c
b/gcc/testsuite/gcc.target/aarch64/pr110449.c
index bb3b6dcfe08d..51ca3f4b816c 100644
--- a/gcc/testsuite/gcc.target/aarch64/pr110449.c
+++ b/gcc/testsuite/gcc.target/aarch64/pr110449.c
@@ -1,8 +1,10 @@
/* { dg-do compile } */
/* { dg-options "-Ofast -mcpu=neoverse-n2 --param aarch64-vect-unroll-limit=2"
} */
-/* { dg-final { scan-assembler-not "8.0e\\+0" } } */
+/* { dg-final { scan-assembler {, #?8.0e\+0} } } */
+/* { dg-final { scan-assembler-not {\tmov\tv} } } */
-/* Calcualte the vectorized induction with smaller step for an unrolled loop.
+/* Insert the induction IV updates before the exit condition, rather than
+ at the start of the loop body.
before (suggested_unroll_factor=2):
fmovs30, 8.0e+0
@@ -19,15 +21,16 @@
bne .L6
after:
- fmovs31, 4.0e+0
- dup v29.4s, v31.s[0]
- .L6:
- faddv30.4s, v31.4s, v29.4s
- stp q31, q30, [x0]
- add x0, x0, 32
- faddv31.4s, v29.4s, v30.4s
- cmp x0, x1
- bne .L6 */
+ fmovs31, 8.0e+0
+ fmovs29, 4.0e+0
+ dup v31.4s, v31.s[0]
+ dup v29.4s, v29.s[0]
+ .L2:
+ faddv30.4s, v0.4s, v29.4s
+ stp q0, q30, [x0], 32
+ faddv0.4s, v0.4s, v31.4s
+ cmp x1, x0
+ bne .L2 */
void
foo2 (float *arr, float freq, float step)
diff --git a/gcc/tree-ssa-loop-manip.cc b/gcc/tree-ssa-loop-manip.cc
index 6ceb9df370b2..2907fa6532d8 100644
--- a/gcc/tree-ssa-loop-manip.cc
+++ b/gcc/tree-ssa-loop-manip.cc
@@ -47,6 +47,39 @@ along with GCC; see the file COPYING3. If not see
so that we can free them all at once. */
static bitmap_obstack loop_renamer_obstack;
+/* Insert IV increment statements STMTS before or after INCR_POS;
+ AFTER selects which. INCR_POS and AFTER can be computed using
+ standard_iv_increment_position. */
+
+void
+insert_iv_increment (gimple_stmt_iterator *incr_pos, bool after,
+gimple_seq stmts)
+{
+ /* Prevent the increment from inheriting a bogus location if it is not put
+ immediately after a statement whose location is kno
[gcc(refs/users/meissner/heads/work192-bugs)] Fix PR 118541, do not generate unordered fp cmoves for IEEE compares.
https://gcc.gnu.org/g:b098f53e201667b5eaa437f9da2c85fe3311fcaf
commit b098f53e201667b5eaa437f9da2c85fe3311fcaf
Author: Michael Meissner
Date: Thu Feb 6 15:11:13 2025 -0500
Fix PR 118541, do not generate unordered fp cmoves for IEEE compares.
This is version 2 of the patch.
In bug PR target/118541 on power9, power10, and power11 systems, for the
function:
extern double __ieee754_acos (double);
double
__acospi (double x)
{
double ret = __ieee754_acos (x) / 3.14;
return __builtin_isgreater (ret, 1.0) ? 1.0 : ret;
}
GCC currently generates the following code:
Power9 Power10 and Power11
== ===
bl __ieee754_acos bl __ieee754_acos@notoc
nop plfd 0,.LC0@pcrel
addis 9,2,.LC2@toc@ha xxspltidp 12,1065353216
addi 1,1,32 addi 1,1,32
lfd 0,.LC2@toc@l(9) ld 0,16(1)
addis 9,2,.LC0@toc@ha fdiv 0,1,0
ld 0,16(1) mtlr 0
lfd 12,.LC0@toc@l(9)xscmpgtdp 1,0,12
fdiv 0,1,0 xxsel 1,0,12,1
mtlr 0 blr
xscmpgtdp 1,0,12
xxsel 1,0,12,1
blr
This is because ifcvt.c optimizes the conditional floating point move to
use the
XSCMPGTDP instruction.
However, the XSCMPGTDP instruction will generate an interrupt if one of the
arguments is a signalling NaN and signalling NaNs can generate an interrupt.
The IEEE comparison functions (isgreater, etc.) require that the comparison
not
raise an interrupt.
The following patch changes the PowerPC back end so that ifcvt.c will not
change
the if/then test and move into a conditional move if the comparison is one
of
the comparisons that do not raise an error with signalling NaNs and -Ofast
is
not used. If a normal comparison is used or -Ofast is used, GCC will
continue
to generate XSCMPGTDP and XXSEL.
For the following code:
double
ordered_compare (double a, double b, double c, double d)
{
return __builtin_isgreater (a, b) ? c : d;
}
/* Verify normal > does generate xscmpgtdp. */
double
normal_compare (double a, double b, double c, double d)
{
return a > b ? c : d;
}
with the following patch, GCC generates the following for power9, power10,
and
power11:
ordered_compare:
fcmpu 0,1,2
fmr 1,4
bnglr 0
fmr 1,3
blr
normal_compare:
xscmpgtdp 1,1,2
xxsel 1,4,3,1
blr
Changes from the V1 patch:
1: I added a test in invert_fpmask_comparison_operator to not allow UNLE and
UNLT unless fast math is in force. Both invert_fpmask_comparison_operator
and
fpmask_comparison_operator are used to form floating point conditional
moves on
Power9 and beyond.
2: I reworked rs6000_reverse_condition to be a bit clearer when we are
rejecting
reversing IEEE comparisons that guarantee they don't trap.
I have built bootstrap compilers on big endian power9 systems and little
endian
power9/power10 systems and there were no regressions. Can I check this
patch
into the GCC trunk, and after a waiting period, can I check this into the
active
older branches?
2025-02-06 Michael Meissner
gcc/
PR target/118541
* config/rs6000/predicates.md (invert_fpmask_comparison_operator):
Do
not allow UNLT and UNLE unless -ffast-math.
* config/rs6000/rs6000-protos.h (REVERSE_COND_ORDERED_OK): New
macro.
(REVERSE_COND_NO_ORDERED): Likewise.
(rs6000_reverse_condition): Add argument.
* config/rs6000/rs6000.cc (rs6000_reverse_condition): Do not allow
ordered comparisons to be reversed for floating point cmoves.
(rs6000_emit_sCOND): Adjust rs6000_reverse_condition call.
* config/rs6000/rs6000.h (REVERSE_CONDITION): Likewise.
* config/rs6000/rs6000.md (reverse_branch_comparison): Name insn.
Adjust rs6000_reverse_condition call.
gcc/testsuite/
PR target/118541
* gcc.target/powerpc/pr118541.c: New test.
Diff:
---
gcc/config/rs6000/predicates.md | 8 --
gcc/config/rs6000/rs6000-protos.h | 6 +++-
gcc/config/rs6000/rs6000.cc | 36 ++--
gcc/config/rs
[gcc(refs/users/meissner/heads/work192-bugs)] Update ChangeLog.*
https://gcc.gnu.org/g:076eefb48d7720ad4e609fb8b5ad84e1da57e3a2 commit 076eefb48d7720ad4e609fb8b5ad84e1da57e3a2 Author: Michael Meissner Date: Thu Feb 6 15:12:34 2025 -0500 Update ChangeLog.* Diff: --- gcc/ChangeLog.bugs | 15 ++- 1 file changed, 14 insertions(+), 1 deletion(-) diff --git a/gcc/ChangeLog.bugs b/gcc/ChangeLog.bugs index 285b35930a1c..4bedd11965be 100644 --- a/gcc/ChangeLog.bugs +++ b/gcc/ChangeLog.bugs @@ -1,7 +1,9 @@ - Branch work192-bugs, patch #211 + Branch work192-bugs, patch #214 Fix PR 118541, do not generate unordered fp cmoves for IEEE compares. +This is version 2 of the patch. + In bug PR target/118541 on power9, power10, and power11 systems, for the function: @@ -77,6 +79,16 @@ power11: xxsel 1,4,3,1 blr +Changes from the V1 patch: + +1: I added a test in invert_fpmask_comparison_operator to not allow UNLE and +UNLT unless fast math is in force. Both invert_fpmask_comparison_operator and +fpmask_comparison_operator are used to form floating point conditional moves on +Power9 and beyond. + +2: I reworked rs6000_reverse_condition to be a bit clearer when we are rejecting +reversing IEEE comparisons that guarantee they don't trap. + I have built bootstrap compilers on big endian power9 systems and little endian power9/power10 systems and there were no regressions. Can I check this patch into the GCC trunk, and after a waiting period, can I check this into the active @@ -104,6 +116,7 @@ gcc/testsuite/ PR target/118541 * gcc.target/powerpc/pr118541.c: New test. + Branch work192-bugs, patch #213 was reverted Branch work192-bugs, patch #212 was reverted Branch work192-bugs, patch #211 was reverted Branch work192-bugs, patch #210 was reverted
[gcc r15-7397] [RISC-V] Fix risc-v expected test output after recent iv changes
https://gcc.gnu.org/g:33e610110c933b0d65aa82d67864bb881768609f
commit r15-7397-g33e610110c933b0d65aa82d67864bb881768609f
Author: Jeff Law
Date: Thu Feb 6 12:37:11 2025 -0700
[RISC-V] Fix risc-v expected test output after recent iv changes
Richard S's recent change to iv increment insertion removed a reg->reg move
(which was its intent AFAICT). This triggered a failure on a riscv test.
That test was meant to verify that we didn't have an extraneous reg->reg
move
due to a buglet in the risc-v splitters. Before the 2023 change we had two
vector reg->reg moves and after the 2023 fix we had just one. With
Richard's
change we have none ;-) Adjusting test accordingly.
Pushed to the trunk.
gcc/testsuite
* gcc.target/riscv/rvv/autovec/madd-split2-1.c: Update expected
output.
Diff:
---
gcc/testsuite/gcc.target/riscv/rvv/autovec/madd-split2-1.c | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/gcc/testsuite/gcc.target/riscv/rvv/autovec/madd-split2-1.c
b/gcc/testsuite/gcc.target/riscv/rvv/autovec/madd-split2-1.c
index 4f99a5f87c46..8cc0c9f407c9 100644
--- a/gcc/testsuite/gcc.target/riscv/rvv/autovec/madd-split2-1.c
+++ b/gcc/testsuite/gcc.target/riscv/rvv/autovec/madd-split2-1.c
@@ -10,4 +10,4 @@ foo (long *__restrict a, long *__restrict b, long n)
return a[1];
}
-/* { dg-final { scan-assembler-times {\tvmv1r\.v} 1 } } */
+/* { dg-final { scan-assembler-not {\tvmv1r\.v} } } */
[gcc(refs/users/meissner/heads/work192-bugs)] Revert changes
https://gcc.gnu.org/g:897213384b4be0faab1b355d01e2c02e4e96f57b
commit 897213384b4be0faab1b355d01e2c02e4e96f57b
Author: Michael Meissner
Date: Thu Feb 6 14:44:36 2025 -0500
Revert changes
Diff:
---
gcc/config/rs6000/predicates.md | 8 ++
gcc/config/rs6000/rs6000-protos.h | 6 +---
gcc/config/rs6000/rs6000.cc | 29 ++-
gcc/config/rs6000/rs6000.h | 10 ++-
gcc/config/rs6000/rs6000.md | 24 ++--
gcc/testsuite/gcc.target/powerpc/pr118541.c | 43 -
6 files changed, 22 insertions(+), 98 deletions(-)
diff --git a/gcc/config/rs6000/predicates.md b/gcc/config/rs6000/predicates.md
index 700b266b62f5..647e89afb6a7 100644
--- a/gcc/config/rs6000/predicates.md
+++ b/gcc/config/rs6000/predicates.md
@@ -1465,13 +1465,9 @@
;; Return 1 if OP is a comparison operator suitable for vector/scalar
;; comparisons that generate a 0/-1 mask (i.e. the inverse of
-;; fpmask_comparison_operator). Do not allow UNLT and UNLE unless fast math is
-;; used since the power9 compare and mask instructions will raise an exception
-;; if one of the arguments is a signalling NaN.
+;; fpmask_comparison_operator).
(define_predicate "invert_fpmask_comparison_operator"
- (ior (match_code "ne")
- (and (match_code "unlt,unle")
- (match_test "!HONOR_NANS (DFmode)"
+ (match_code "ne,unlt,unle"))
;; Return 1 if OP is a comparison operation suitable for integer vector/scalar
;; comparisons that generate a -1/0 mask.
diff --git a/gcc/config/rs6000/rs6000-protos.h
b/gcc/config/rs6000/rs6000-protos.h
index 112332660d3b..4619142d197b 100644
--- a/gcc/config/rs6000/rs6000-protos.h
+++ b/gcc/config/rs6000/rs6000-protos.h
@@ -114,12 +114,8 @@ extern const char *rs6000_sibcall_template (rtx *,
unsigned int);
extern const char *rs6000_indirect_call_template (rtx *, unsigned int);
extern const char *rs6000_indirect_sibcall_template (rtx *, unsigned int);
extern const char *rs6000_pltseq_template (rtx *, int);
-
-#define REVERSE_COND_ORDERED_OKfalse
-#define REVERSE_COND_NO_ORDEREDtrue
-
extern enum rtx_code rs6000_reverse_condition (machine_mode,
- enum rtx_code, bool);
+ enum rtx_code);
extern rtx rs6000_emit_eqne (machine_mode, rtx, rtx, rtx);
extern rtx rs6000_emit_fp_cror (rtx_code, machine_mode, rtx);
extern void rs6000_emit_sCOND (machine_mode, rtx[]);
diff --git a/gcc/config/rs6000/rs6000.cc b/gcc/config/rs6000/rs6000.cc
index d1bf2d29f3da..f9f9a0b931db 100644
--- a/gcc/config/rs6000/rs6000.cc
+++ b/gcc/config/rs6000/rs6000.cc
@@ -15360,27 +15360,17 @@ rs6000_print_patchable_function_entry (FILE *file,
}
enum rtx_code
-rs6000_reverse_condition (machine_mode cc_mode,
- enum rtx_code code,
- bool no_ordered)
+rs6000_reverse_condition (machine_mode mode, enum rtx_code code)
{
/* Reversal of FP compares takes care -- an ordered compare
- becomes an unordered compare and vice versa.
-
- However, this is not safe for ordered comparisons (i.e. for isgreater,
- etc.) starting with the power9 because ifcvt.cc will want to create a fp
- cmove, and the x{s,v}cmp{eq,gt,ge}{dp,qp} instructions will trap if one of
- the arguments is a signalling NaN. */
-
- if (cc_mode == CCFPmode
+ becomes an unordered compare and vice versa. */
+ if (mode == CCFPmode
&& (!flag_finite_math_only
|| code == UNLT || code == UNLE || code == UNGT || code == UNGE
|| code == UNEQ || code == LTGT))
-return (no_ordered
- ? UNKNOWN
- : reverse_condition_maybe_unordered (code));
-
- return reverse_condition (code);
+return reverse_condition_maybe_unordered (code);
+ else
+return reverse_condition (code);
}
/* Check if C (as 64bit integer) can be rotated to a constant which constains
@@ -15990,14 +15980,11 @@ rs6000_emit_sCOND (machine_mode mode, rtx operands[])
rtx not_result = gen_reg_rtx (CCEQmode);
rtx not_op, rev_cond_rtx;
machine_mode cc_mode;
- enum rtx_code rev;
cc_mode = GET_MODE (XEXP (condition_rtx, 0));
- rev = rs6000_reverse_condition (cc_mode, cond_code,
- REVERSE_COND_ORDERED_OK);
- rev_cond_rtx = gen_rtx_fmt_ee (rev, SImode, XEXP (condition_rtx, 0),
-const0_rtx);
+ rev_cond_rtx = gen_rtx_fmt_ee (rs6000_reverse_condition (cc_mode,
cond_code),
+SImode, XEXP (condition_rtx, 0),
const0_rtx);
not_op = gen_rtx_COMPARE (CCEQmode, rev_cond_rtx, const0_rtx);
emit_insn (gen_rtx_SET (not_result, not_op));
condition_rtx = gen_rtx_EQ (VOIDmode, not_result, const0_rtx);
diff --git a/gcc/config/rs6000/rs6000.h b/gcc/config/rs6000/rs6000.h
index c595d7138bcd..ec08c96d0f67 100644
--
[gcc r14-11276] Fortran: host association issue with symbol in COMMON block [PR108454]
https://gcc.gnu.org/g:ca652aebd30132b2a9afbc07c664a35b5e443350
commit r14-11276-gca652aebd30132b2a9afbc07c664a35b5e443350
Author: Harald Anlauf
Date: Thu Jan 30 22:21:19 2025 +0100
Fortran: host association issue with symbol in COMMON block [PR108454]
When resolving a flavorless symbol that is already registered with a COMMON
block, and which neither has the intrinsic, generic, or external attribute,
skip searching among interfaces to avoid false resolution to a derived type
of the same name.
PR fortran/108454
gcc/fortran/ChangeLog:
* resolve.cc (resolve_common_blocks): Initialize variable.
(resolve_symbol): If a symbol is already registered with a COMMON
block, do not search for an interface with the same name.
gcc/testsuite/ChangeLog:
* gfortran.dg/common_29.f90: New test.
(cherry picked from commit d6418fe22684f9335474d1fd405ade45954c069d)
Diff:
---
gcc/fortran/resolve.cc | 9 -
gcc/testsuite/gfortran.dg/common_29.f90 | 34 +
2 files changed, 42 insertions(+), 1 deletion(-)
diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index ca591e15e01e..4d5e8b5537ab 100644
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -1040,7 +1040,7 @@ resolve_common_vars (gfc_common_head *common_block, bool
named_common)
static void
resolve_common_blocks (gfc_symtree *common_root)
{
- gfc_symbol *sym;
+ gfc_symbol *sym = NULL;
gfc_gsymbol * gsym;
if (common_root == NULL)
@@ -16354,6 +16354,12 @@ resolve_symbol (gfc_symbol *sym)
&& sym->attr.if_source == IFSRC_UNKNOWN
&& sym->ts.type == BT_UNKNOWN))
{
+ /* A symbol in a common block might not have been resolved yet properly.
+Do not try to find an interface with the same name. */
+ if (sym->attr.flavor == FL_UNKNOWN && !sym->attr.intrinsic
+ && !sym->attr.generic && !sym->attr.external
+ && sym->attr.in_common)
+ goto skip_interfaces;
/* If we find that a flavorless symbol is an interface in one of the
parent namespaces, find its symtree in this namespace, free the
@@ -16377,6 +16383,7 @@ resolve_symbol (gfc_symbol *sym)
}
}
+skip_interfaces:
/* Otherwise give it a flavor according to such attributes as
it has. */
if (sym->attr.flavor == FL_UNKNOWN && sym->attr.external == 0
diff --git a/gcc/testsuite/gfortran.dg/common_29.f90
b/gcc/testsuite/gfortran.dg/common_29.f90
new file mode 100644
index ..66f2a18a4836
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/common_29.f90
@@ -0,0 +1,34 @@
+! { dg-do compile }
+! PR fortran/108454
+!
+! Contributed by G.Steinmetz
+
+module m
+ type t
+ end type
+contains
+ subroutine s
+common t
+ end
+end
+
+module m2
+ implicit none
+ type t
+ end type
+contains
+ subroutine s
+real :: t
+common /com/ t
+ end
+end
+
+module m3
+ type t
+ end type
+contains
+ subroutine s
+type(t) :: x ! { dg-error "cannot be host associated at .1." }
+common t ! { dg-error "incompatible object of the same name" }
+ end
+end
[gcc r15-7387] AVR: genmultilib.awk - Use more robust parsing of spaces.
https://gcc.gnu.org/g:5282e13a938404d7d4edc0ccfe6cbe9b4f980d7e
commit r15-7387-g5282e13a938404d7d4edc0ccfe6cbe9b4f980d7e
Author: Georg-Johann Lay
Date: Wed Feb 5 12:01:55 2025 +0100
AVR: genmultilib.awk - Use more robust parsing of spaces.
gcc/
PR target/118768
* config/avr/genmultilib.awk: Parse the AVR_MCU lines in
a more robust way w.r.t. white spaces.
Diff:
---
gcc/config/avr/genmultilib.awk | 37 -
1 file changed, 32 insertions(+), 5 deletions(-)
diff --git a/gcc/config/avr/genmultilib.awk b/gcc/config/avr/genmultilib.awk
index 71099e80fbbc..e824be6e7657 100644
--- a/gcc/config/avr/genmultilib.awk
+++ b/gcc/config/avr/genmultilib.awk
@@ -31,6 +31,7 @@ BEGIN {
FS ="[(, \t]+"
option[""] = ""
comment = 1
+cols_expected = -1
dir_tiny = "tiny-stack"
opt_tiny = "msp8"
@@ -136,10 +137,36 @@ BEGIN {
##
/^AVR_MCU/ {
-name = $2
-gsub ("\"", "", name)
+line = $0
+gsub (/\(/, ",", line)
+gsub (/[ \t")]/, "", line)
+n_cols = split (line, col, ",")
+
+# Now we have col[] something like:
+# col[1] = AVR_MCU
+# col[2] = avr2 # Device name
+# col[3] = ARCH_AVR2 # Core
+# col[4] = AVR_ERRATA_SKIP # Device Attributes
+# col[5] = NULL # Device Macro like __AVR_ATtiny22__
+# col[6] = 0x0060# Tdata
+# col[7] = 0x0 # Ttext
+# col[8] = 0x6 # Flash Size
+# col[9] = 0 # PM Offset
+
+# Sanity check the number of columns.
+if (cols_expected == -1)
+ cols_expected = n_cols
+else if (n_cols != cols_expected)
+{
+ msg = "genmultilib.awk: error: wrong number of columns"
+ print msg | "cat 1>&2"
+ print $0 | "cat 1>&2"
+ exit 1
+}
+
+name = col[2]
-if ($5 == "NULL")
+if (col[5] == "NULL")
{
core = name
@@ -169,9 +196,9 @@ BEGIN {
opts = option[core]
# split device specific feature list
-n = split($4,dev_attribute,"|")
+n = split (col[4], dev_attribute, "|")
-for (i=1; i <= n; i++)
+for (i = 1; i <= n; i++)
{
if (dev_attribute[i] == "AVR_SHORT_SP")
opts = opts "/" opt_tiny
[gcc r15-7391] c++: Add nodiscard attribute further test coverage [PR110345]
https://gcc.gnu.org/g:7169ee08203878ba351eedf206df7ff43014d634
commit r15-7391-g7169ee08203878ba351eedf206df7ff43014d634
Author: Jakub Jelinek
Date: Thu Feb 6 18:32:32 2025 +0100
c++: Add nodiscard attribute further test coverage [PR110345]
Fairly non-problematic attribute.
2025-02-06 Jakub Jelinek
PR c++/110345
* g++.dg/cpp0x/attr-nodiscard1.C: New test.
Diff:
---
gcc/testsuite/g++.dg/cpp0x/attr-nodiscard1.C | 155 +++
1 file changed, 155 insertions(+)
diff --git a/gcc/testsuite/g++.dg/cpp0x/attr-nodiscard1.C
b/gcc/testsuite/g++.dg/cpp0x/attr-nodiscard1.C
new file mode 100644
index ..5abdd380f9d2
--- /dev/null
+++ b/gcc/testsuite/g++.dg/cpp0x/attr-nodiscard1.C
@@ -0,0 +1,155 @@
+// C++ 26 P2552R3 - On the ignorability of standard attributes
+// { dg-do compile { target c++11 } }
+
+int arr[2];
+struct S { int a, b; };
+S arr2[2];
+
+void
+foo (int n)
+{
+ struct [[nodiscard]] S1 {};
+ struct [[nodiscard ("foobar")]] S2 {};
+ struct [[nodiscard (0)]] S3 {}; // { dg-error "'nodiscard'
attribute argument must be a string constant" }
+ struct [[nodiscard ("foo", "bar", "baz")]] S4 {};// { dg-error "wrong
number of arguments specified for 'nodiscard' attribute" }
+ struct [[nodiscard (0, 1, 2)]] S5 {};// { dg-error "wrong
number of arguments specified for 'nodiscard' attribute" }
+
+ auto a = [] [[nodiscard]] () {};
+ auto b = [] constexpr [[nodiscard]] {}; // { dg-warning "'nodiscard'
attribute can only be applied to functions or to class or enumeration types" }
+ // { dg-error "parameter
declaration before lambda declaration specifiers only optional with" "" {
target c++20_down } .-1 }
+ // { dg-error "'constexpr'
lambda only available with" "" { target c++14_down } .-2 }
+ auto c = [] noexcept [[nodiscard]] {}; // { dg-warning "'nodiscard'
attribute can only be applied to functions or to class or enumeration types" }
+ // { dg-error "parameter
declaration before lambda exception specification only optional with" "" {
target c++20_down } .-1 }
+ auto d = [] () [[nodiscard]] {}; // { dg-warning "'nodiscard'
attribute can only be applied to functions or to class or enumeration types" }
+ auto e = new int [n] [[nodiscard]]; // { dg-warning "attributes
ignored on outermost array type in new expression" }
+ auto e2 = new int [n] [[nodiscard]] [42];// { dg-warning "attributes
ignored on outermost array type in new expression" }
+ auto f = new int [n][42] [[nodiscard]]; // { dg-warning "'nodiscard'
attribute can only be applied to functions or to class or enumeration types" }
+ [[nodiscard]]; // { dg-warning "attributes at
the beginning of statement are ignored" }
+ [[nodiscard]] {} // { dg-warning "attributes at
the beginning of statement are ignored" }
+ [[nodiscard]] if (true) {} // { dg-warning "attributes at
the beginning of statement are ignored" }
+ [[nodiscard]] while (false) {} // { dg-warning "attributes at
the beginning of statement are ignored" }
+ [[nodiscard]] goto lab; // { dg-warning "attributes at
the beginning of statement are ignored" }
+ [[nodiscard]] lab:; // { dg-warning "'nodiscard'
attribute can only be applied to functions or to class or enumeration types" }
+ [[nodiscard]] try {} catch (int) {} // { dg-warning "attributes at
the beginning of statement are ignored" }
+ if ([[nodiscard]] int x = 0) {} // { dg-warning "'nodiscard'
attribute can only be applied to functions or to class or enumeration types" }
+ switch (n)
+{
+[[nodiscard]] case 1: // { dg-warning "'nodiscard'
attribute can only be applied to functions or to class or enumeration types" }
+[[nodiscard]] break; // { dg-warning "attributes at
the beginning of statement are ignored" }
+[[nodiscard]] default: // { dg-warning "'nodiscard'
attribute can only be applied to functions or to class or enumeration types" }
+break;
+}
+ for ([[nodiscard]] auto a : arr) {} // { dg-warning "'nodiscard'
attribute can only be applied to functions or to class or enumeration types" }
+ for ([[nodiscard]] auto [a, b] : arr2) {}// { dg-warning "'nodiscard'
attribute can only be applied to functions or to class or enumeration types" }
+ // { dg-error "structured
bindings only available with" "" { target c++14_down } .-1 }
+ [[nodiscard]] asm (""); // { dg-warning "attributes
ignored on 'asm' declaration" }
+ try {} catch ([[nodiscard]] int x) {}// { dg-w
[gcc r15-7392] c++: Add noreturn attribute further test coverage [PR110345]
https://gcc.gnu.org/g:122b946cc632e472ee6d828f8adf05567cfaa831
commit r15-7392-g122b946cc632e472ee6d828f8adf05567cfaa831
Author: Jakub Jelinek
Date: Thu Feb 6 18:34:01 2025 +0100
c++: Add noreturn attribute further test coverage [PR110345]
Another non-problematic attribute.
2025-02-06 Jakub Jelinek
PR c++/110345
* g++.dg/cpp0x/attr-noreturn1.C: New test.
Diff:
---
gcc/testsuite/g++.dg/cpp0x/attr-noreturn1.C | 160
1 file changed, 160 insertions(+)
diff --git a/gcc/testsuite/g++.dg/cpp0x/attr-noreturn1.C
b/gcc/testsuite/g++.dg/cpp0x/attr-noreturn1.C
new file mode 100644
index ..91f1e803a3d8
--- /dev/null
+++ b/gcc/testsuite/g++.dg/cpp0x/attr-noreturn1.C
@@ -0,0 +1,160 @@
+// C++ 26 P2552R3 - On the ignorability of standard attributes
+// { dg-do compile { target c++11 } }
+
+int arr[2];
+struct S { int a, b; };
+S arr2[2];
+
+[[noreturn]] void foo1 ();
+[[noreturn ("foobar")]] void foo2 (); // { dg-error "'noreturn'
attribute does not take any arguments" }
+[[noreturn (0)]] void foo3 (); // { dg-error "'noreturn'
attribute does not take any arguments" }
+
+void
+foo (int n)
+{
+ auto a = [] [[noreturn]] () { do { } while (true); };
+ auto b = [] constexpr [[noreturn]] {}; // { dg-warning "'noreturn'
attribute does not apply to types" }
+ // { dg-error "parameter
declaration before lambda declaration specifiers only optional with" "" {
target c++20_down } .-1 }
+ // { dg-error "'constexpr'
lambda only available with" "" { target c++14_down } .-2 }
+ auto c = [] noexcept [[noreturn]] {};// { dg-warning
"'noreturn' attribute does not apply to types" }
+ // { dg-error "parameter
declaration before lambda exception specification only optional with" "" {
target c++20_down } .-1 }
+ auto d = [] () [[noreturn]] {}; // { dg-warning "'noreturn'
attribute does not apply to types" }
+ auto e = new int [n] [[noreturn]]; // { dg-warning "attributes
ignored on outermost array type in new expression" }
+ auto e2 = new int [n] [[noreturn]] [42]; // { dg-warning "attributes
ignored on outermost array type in new expression" }
+ auto f = new int [n][42] [[noreturn]]; // { dg-warning "'noreturn'
attribute does not apply to types" }
+ [[noreturn]];// { dg-warning
"attributes at the beginning of statement are ignored" }
+ [[noreturn]] {} // { dg-warning "attributes at
the beginning of statement are ignored" }
+ [[noreturn]] if (true) {}// { dg-warning "attributes at
the beginning of statement are ignored" }
+ [[noreturn]] while (false) {}// { dg-warning
"attributes at the beginning of statement are ignored" }
+ [[noreturn]] goto lab; // { dg-warning "attributes at
the beginning of statement are ignored" }
+ [[noreturn]] lab:; // { dg-warning "'noreturn'
attribute ignored" }
+ [[noreturn]] try {} catch (int) {} // { dg-warning "attributes at
the beginning of statement are ignored" }
+ if ([[noreturn]] int x = 0) {} // { dg-warning "'noreturn'
attribute ignored" }
+ switch (n)
+{
+[[noreturn]] case 1: // { dg-warning "'noreturn'
attribute ignored" }
+[[noreturn]] break;// { dg-warning
"attributes at the beginning of statement are ignored" }
+[[noreturn]] default: // { dg-warning "'noreturn'
attribute ignored" }
+break;
+}
+ for ([[noreturn]] auto a : arr) {} // { dg-warning "'noreturn'
attribute ignored" }
+ for ([[noreturn]] auto [a, b] : arr2) {} // { dg-warning "'noreturn'
attribute ignored" }
+ // { dg-error "structured
bindings only available with" "" { target c++14_down } .-1 }
+ [[noreturn]] asm (""); // { dg-warning "attributes
ignored on 'asm' declaration" }
+ try {} catch ([[noreturn]] int x) {} // { dg-warning "'noreturn'
attribute ignored" }
+ try {} catch ([[noreturn]] int) {} // { dg-warning "'noreturn'
attribute ignored" }
+ try {} catch (int [[noreturn]] x) {} // { dg-warning "attribute
ignored" }
+ try {} catch (int [[noreturn]]) {} // { dg-warning "attribute
ignored" }
+ try {} catch (int x [[noreturn]]) {} // { dg-warning "'noreturn'
attribute ignored" }
+}
+
+[[noreturn]] int bar ();
+using foobar [[noreturn]] = int; // { dg-warning "'noreturn'
attribute ignored" }
+[[noreturn]] int a;// { dg-warning "'noreturn'
attribute ignored" }
+[[noreturn]] auto [b, c] = arr;//
[gcc r15-7394] Fortran: Fix handling of the X edit descriptor.
https://gcc.gnu.org/g:cfed99751c1a3b93ca66451eb1b62271e682f927
commit r15-7394-gcfed99751c1a3b93ca66451eb1b62271e682f927
Author: Jerry DeLisle
Date: Wed Jan 29 13:40:59 2025 -0800
Fortran: Fix handling of the X edit descriptor.
This patch is a partial fix of handling of X edit descriptors
when combined with certain T edit descriptors.
PR libfortran/114618
libgfortran/ChangeLog:
* io/transfer.c (formatted_transfer_scalar_write): Change name
of vriable 'pos' to 'tab_pos' to improve clarity. Add new
variable next_pos when calculating the maximum position.
Update the calculation of pending spaces.
gcc/testsuite/ChangeLog:
* gfortran.dg/pr114618.f90: New test.
Diff:
---
gcc/testsuite/gfortran.dg/pr114618.f90 | 15 +++
libgfortran/io/transfer.c | 75 ++
2 files changed, 64 insertions(+), 26 deletions(-)
diff --git a/gcc/testsuite/gfortran.dg/pr114618.f90
b/gcc/testsuite/gfortran.dg/pr114618.f90
new file mode 100644
index ..835597b8513d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr114618.f90
@@ -0,0 +1,15 @@
+! { dg-do run }
+! PR114618 Format produces incorrect output when contains 1x, ok when uses " "
+! aside: Before patch output1 is garbage.
+program pr114618
+ implicit none
+ integer, parameter :: wp = kind(0d0)
+ real(kind=wp) :: pi = 3.14159265358979323846264338_wp
+ character(len=*), parameter:: fmt1 = '(19("."),t1,g0,1x,t21,g0)'
+ character(len=*), parameter:: fmt2 = '(19("."),t1,g0," ",t21,g0)'
+ character(21) :: output1, output2
+ write (output1, fmt1) 'RADIX', radix(pi)
+ write (output2, fmt2) 'RADIX', radix(pi)
+ if (output1 /= 'RADIX.. 2') stop 1
+ if (output2 /= 'RADIX . 2') stop 2
+end program pr114618
diff --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c
index b3b72f39c5b1..3fc53938b4a2 100644
--- a/libgfortran/io/transfer.c
+++ b/libgfortran/io/transfer.c
@@ -2068,12 +2068,14 @@ static void
formatted_transfer_scalar_write (st_parameter_dt *dtp, bt type, void *p, int
kind,
size_t size)
{
- gfc_offset pos, bytes_used;
+ gfc_offset tab_pos, bytes_used;
const fnode *f;
format_token t;
int n;
int consume_data_flag;
+ tab_pos = 0; bytes_used = 0;
+
/* Change a complex data item into a pair of reals. */
n = (p == NULL) ? 0 : ((type != BT_COMPLEX) ? 1 : 2);
@@ -2398,10 +2400,12 @@ formatted_transfer_scalar_write (st_parameter_dt *dtp,
bt type, void *p, int kin
case FMT_X:
case FMT_TR:
consume_data_flag = 0;
-
dtp->u.p.skips += f->u.n;
- pos = bytes_used + dtp->u.p.skips - 1;
- dtp->u.p.pending_spaces = pos - dtp->u.p.max_pos + 1;
+ tab_pos = bytes_used + dtp->u.p.skips - 1;
+ dtp->u.p.pending_spaces = tab_pos - dtp->u.p.max_pos + 1;
+ dtp->u.p.pending_spaces = dtp->u.p.pending_spaces < 0
+ ? f->u.n : dtp->u.p.pending_spaces;
+
/* Writes occur just before the switch on f->format, above, so
that trailing blanks are suppressed, unless we are doing a
non-advancing write in which case we want to output the blanks
@@ -2414,35 +2418,50 @@ formatted_transfer_scalar_write (st_parameter_dt *dtp,
bt type, void *p, int kin
break;
case FMT_TL:
- case FMT_T:
consume_data_flag = 0;
-
- if (f->format == FMT_TL)
+ /* Handle the special case when no bytes have been used yet.
+Cannot go below zero. */
+ if (bytes_used == 0)
{
-
- /* Handle the special case when no bytes have been used yet.
-Cannot go below zero. */
- if (bytes_used == 0)
- {
- dtp->u.p.pending_spaces -= f->u.n;
- dtp->u.p.skips -= f->u.n;
- dtp->u.p.skips = dtp->u.p.skips < 0 ? 0 : dtp->u.p.skips;
- }
-
- pos = bytes_used - f->u.n;
+ dtp->u.p.pending_spaces -= f->u.n;
+ dtp->u.p.skips -= f->u.n;
+ dtp->u.p.skips = dtp->u.p.skips < 0 ? 0 : dtp->u.p.skips;
}
- else /* FMT_T */
- pos = f->u.n - dtp->u.p.pending_spaces - 1;
+
+ tab_pos = bytes_used - f->u.n;
/* Standard 10.6.1.1: excessive left tabbing is reset to the
left tab limit. We do not check if the position has gone
beyond the end of record because a subsequent tab could
bring us back again. */
- pos = pos < 0 ? 0 : pos;
+ tab_pos = tab_pos < 0 ? 0 : tab_pos;
- dtp->u.p.skips = dtp->u.p.skips + pos - bytes_used;
+ dtp->u.p.skips = dtp->u.p.skips + tab_pos - bytes_used;
dtp->u.p.pending_spaces = dtp->u.p.pending_spaces
- + pos - dtp->u.p.
[gcc r15-7393] c++: Add no_unique_address attribute further test coverage [PR110345]
https://gcc.gnu.org/g:6305c46fad5ae9b3b94b069c040cdd0c67e6e49e
commit r15-7393-g6305c46fad5ae9b3b94b069c040cdd0c67e6e49e
Author: Jakub Jelinek
Date: Thu Feb 6 18:35:13 2025 +0100
c++: Add no_unique_address attribute further test coverage [PR110345]
Another non-problematic attribute.
2025-02-06 Jakub Jelinek
PR c++/110345
* g++.dg/cpp0x/attr-no_unique_address1.C: New test.
Diff:
---
.../g++.dg/cpp0x/attr-no_unique_address1.C | 151 +
1 file changed, 151 insertions(+)
diff --git a/gcc/testsuite/g++.dg/cpp0x/attr-no_unique_address1.C
b/gcc/testsuite/g++.dg/cpp0x/attr-no_unique_address1.C
new file mode 100644
index ..5f027df04cda
--- /dev/null
+++ b/gcc/testsuite/g++.dg/cpp0x/attr-no_unique_address1.C
@@ -0,0 +1,151 @@
+// C++ 26 P2552R3 - On the ignorability of standard attributes
+// { dg-do compile { target c++11 } }
+
+int arr[2];
+struct S { int a, b; };
+S arr2[2];
+
+struct S2 {
+ [[no_unique_address]] struct {} a;
+ [[no_unique_address ("foobar")]] struct {} b;// { dg-error
"'no_unique_address' attribute does not take any arguments" }
+ [[no_unique_address (0)]] struct {} c; // { dg-error
"'no_unique_address' attribute does not take any arguments" }
+ struct {} d [[no_unique_address]];
+};
+
+void
+foo (int n)
+{
+ auto a = [] [[no_unique_address]] () { };// { dg-warning
"'no_unique_address' attribute can only be applied to non-static data members" }
+ auto b = [] constexpr [[no_unique_address]] {}; // { dg-warning
"'no_unique_address' attribute does not apply to types" }
+ // { dg-error
"parameter declaration before lambda declaration specifiers only optional with"
"" { target c++20_down } .-1 }
+ // { dg-error
"'constexpr' lambda only available with" "" { target c++14_down } .-2 }
+ auto c = [] noexcept [[no_unique_address]] {}; // { dg-warning
"'no_unique_address' attribute does not apply to types" }
+ // { dg-error
"parameter declaration before lambda exception specification only optional
with" "" { target c++20_down } .-1 }
+ auto d = [] () [[no_unique_address]] {}; // { dg-warning
"'no_unique_address' attribute does not apply to types" }
+ auto e = new int [n] [[no_unique_address]]; // { dg-warning
"attributes ignored on outermost array type in new expression" }
+ auto e2 = new int [n] [[no_unique_address]] [42];// { dg-warning
"attributes ignored on outermost array type in new expression" }
+ auto f = new int [n][42] [[no_unique_address]]; // { dg-warning
"'no_unique_address' attribute does not apply to types" }
+ [[no_unique_address]]; // { dg-warning
"attributes at the beginning of statement are ignored" }
+ [[no_unique_address]] {} // { dg-warning
"attributes at the beginning of statement are ignored" }
+ [[no_unique_address]] if (true) {} // { dg-warning
"attributes at the beginning of statement are ignored" }
+ [[no_unique_address]] while (false) {} // { dg-warning
"attributes at the beginning of statement are ignored" }
+ [[no_unique_address]] goto lab; // { dg-warning
"attributes at the beginning of statement are ignored" }
+ [[no_unique_address]] lab:; // { dg-warning
"'no_unique_address' attribute can only be applied to non-static data members" }
+ [[no_unique_address]] try {} catch (int) {} // { dg-warning
"attributes at the beginning of statement are ignored" }
+ if ([[no_unique_address]] int x = 0) {} // { dg-warning
"'no_unique_address' attribute can only be applied to non-static data members" }
+ switch (n)
+{
+[[no_unique_address]] case 1: // { dg-warning
"'no_unique_address' attribute can only be applied to non-static data members" }
+[[no_unique_address]] break; // { dg-warning
"attributes at the beginning of statement are ignored" }
+[[no_unique_address]] default: // { dg-warning
"'no_unique_address' attribute can only be applied to non-static data members" }
+break;
+}
+ for ([[no_unique_address]] auto a : arr) {} // { dg-warning
"'no_unique_address' attribute can only be applied to non-static data members" }
+ for ([[no_unique_address]] auto [a, b] : arr2) {}// { dg-warning
"'no_unique_address' attribute can only be applied to non-static data members" }
+ // { dg-error
"structured bindings only available with" "" { target c++14_down } .-1 }
+ [[no_unique_address]] asm (""); // { dg-warning
"attributes ignored on 'asm' declaration" }
+ try {} catch ([[n
[gcc r15-7395] middle-end: Remove unused internal function after IVopts cleanup [PR118756]
https://gcc.gnu.org/g:8d19fbb2be487f19ed1c48699e17cafe19520525
commit r15-7395-g8d19fbb2be487f19ed1c48699e17cafe19520525
Author: Tamar Christina
Date: Thu Feb 6 17:46:52 2025 +
middle-end: Remove unused internal function after IVopts cleanup [PR118756]
It seems that after my IVopts patches the function contain_complex_addr_expr
became unused and clang is rightfully complaining about it.
This removes the unused internal function.
gcc/ChangeLog:
PR tree-optimization/118756
* tree-ssa-loop-ivopts.cc (contain_complex_addr_expr): Remove.
Diff:
---
gcc/tree-ssa-loop-ivopts.cc | 28
1 file changed, 28 deletions(-)
diff --git a/gcc/tree-ssa-loop-ivopts.cc b/gcc/tree-ssa-loop-ivopts.cc
index 989321137df9..e37b24062f73 100644
--- a/gcc/tree-ssa-loop-ivopts.cc
+++ b/gcc/tree-ssa-loop-ivopts.cc
@@ -1149,34 +1149,6 @@ determine_base_object (struct ivopts_data *data, tree
expr)
return obj;
}
-/* Return true if address expression with non-DECL_P operand appears
- in EXPR. */
-
-static bool
-contain_complex_addr_expr (tree expr)
-{
- bool res = false;
-
- STRIP_NOPS (expr);
- switch (TREE_CODE (expr))
-{
-case POINTER_PLUS_EXPR:
-case PLUS_EXPR:
-case MINUS_EXPR:
- res |= contain_complex_addr_expr (TREE_OPERAND (expr, 0));
- res |= contain_complex_addr_expr (TREE_OPERAND (expr, 1));
- break;
-
-case ADDR_EXPR:
- return (!DECL_P (TREE_OPERAND (expr, 0)));
-
-default:
- return false;
-}
-
- return res;
-}
-
/* Allocates an induction variable with given initial value BASE and step STEP
for loop LOOP. NO_OVERFLOW implies the iv doesn't overflow. */
[gcc r15-7388] loop-iv, riscv: Fix get_biv_step_1 for RISC-V [PR117506]
https://gcc.gnu.org/g:bb9cee8928f7f4dfb94e7a8f232eda736b711450
commit r15-7388-gbb9cee8928f7f4dfb94e7a8f232eda736b711450
Author: Jakub Jelinek
Date: Thu Feb 6 15:39:18 2025 +0100
loop-iv, riscv: Fix get_biv_step_1 for RISC-V [PR117506]
The following test ICEs on RISC-V at least latently since
r14-1622-g99bfdb072e67fa3fe294d86b4b2a9f686f8d9705 which added
RISC-V specific case to get_biv_step_1 to recognize also
({zero,sign}_extend:DI (plus:SI op0 op1))
The reason for the ICE is that op1 in this case is CONST_POLY_INT
which unlike the really expected VOIDmode CONST_INTs has its own
mode and still satisfies CONSTANT_P.
GET_MODE (rhs) (SImode) is different from outer_mode (DImode), so
the function later does
*inner_step = simplify_gen_binary (code, outer_mode,
*inner_step, op1);
but that obviously ICEs because while *inner_step is either VOIDmode
or DImode, op1 has SImode.
The following patch fixes it by extending op1 using code so that
simplify_gen_binary can handle it. Another option would be
to change the !CONSTANT_P (op1) 3 lines above this to
!CONST_INT_P (op1), I think it isn't very likely that we get something
useful from other constants there.
2025-02-06 Jakub Jelinek
PR rtl-optimization/117506
* loop-iv.cc (get_biv_step_1): For {ZERO,SIGN}_EXTEND
of PLUS apply {ZERO,SIGN}_EXTEND to op1.
* gcc.dg/pr117506.c: New test.
* gcc.target/riscv/pr117506.c: New test.
Diff:
---
gcc/loop-iv.cc| 1 +
gcc/testsuite/gcc.dg/pr117506.c | 18 ++
gcc/testsuite/gcc.target/riscv/pr117506.c | 5 +
3 files changed, 24 insertions(+)
diff --git a/gcc/loop-iv.cc b/gcc/loop-iv.cc
index 0ac7e8bc3963..9165f18db476 100644
--- a/gcc/loop-iv.cc
+++ b/gcc/loop-iv.cc
@@ -714,6 +714,7 @@ get_biv_step_1 (df_ref def, scalar_int_mode outer_mode, rtx
reg,
if (!simple_reg_p (op0) || !CONSTANT_P (op1))
return false;
+ op1 = simplify_gen_unary (code, outer_mode, op1, GET_MODE (rhs));
prev_code = code;
code = PLUS;
}
diff --git a/gcc/testsuite/gcc.dg/pr117506.c b/gcc/testsuite/gcc.dg/pr117506.c
new file mode 100644
index ..4f25324645b8
--- /dev/null
+++ b/gcc/testsuite/gcc.dg/pr117506.c
@@ -0,0 +1,18 @@
+/* PR rtl-optimization/117506 */
+/* { dg-do compile } */
+/* { dg-options "-O3 -funroll-loops" } */
+
+char a;
+int b;
+unsigned c;
+short d;
+
+void
+foo ()
+{
+ for (short f = 0; f < c; f += 3)
+{
+ a ^= d;
+ b = b < 0 ? b : 0;
+}
+}
diff --git a/gcc/testsuite/gcc.target/riscv/pr117506.c
b/gcc/testsuite/gcc.target/riscv/pr117506.c
new file mode 100644
index ..ac4b9e35d635
--- /dev/null
+++ b/gcc/testsuite/gcc.target/riscv/pr117506.c
@@ -0,0 +1,5 @@
+/* PR rtl-optimization/117506 */
+/* { dg-do compile } */
+/* { dg-options "-march=rv64im_zve64f -mabi=lp64 -O3 -funroll-loops" } */
+
+#include "../../gcc.dg/pr117506.c"
[gcc r15-7396] avr.opt.urls += -mcvt
https://gcc.gnu.org/g:a69b728b5b9efa34d0af9f9ce0b248d05f7791b0 commit r15-7396-ga69b728b5b9efa34d0af9f9ce0b248d05f7791b0 Author: Georg-Johann Lay Date: Thu Feb 6 19:00:28 2025 +0100 avr.opt.urls += -mcvt gcc/ * config/avr/avr.opt.urls: Add mcvt. Diff: --- gcc/config/avr/avr.opt.urls | 3 +++ 1 file changed, 3 insertions(+) diff --git a/gcc/config/avr/avr.opt.urls b/gcc/config/avr/avr.opt.urls index 89a836f2d0ac..5470fe72591c 100644 --- a/gcc/config/avr/avr.opt.urls +++ b/gcc/config/avr/avr.opt.urls @@ -5,6 +5,9 @@ mcall-prologues UrlSuffix(gcc/AVR-Options.html#index-mcall-prologues) +mcvt +UrlSuffix(gcc/AVR-Options.html#index-mcvt) + mmcu= UrlSuffix(gcc/AVR-Options.html#index-mmcu)
[gcc(refs/users/meissner/heads/work192-bugs)] Revert changes
https://gcc.gnu.org/g:fb9334d7db9286974f1175c03847e24925f71911
commit fb9334d7db9286974f1175c03847e24925f71911
Author: Michael Meissner
Date: Thu Feb 6 15:26:43 2025 -0500
Revert changes
Diff:
---
gcc/config/rs6000/predicates.md | 8 ++
gcc/config/rs6000/rs6000-protos.h | 6 +---
gcc/config/rs6000/rs6000.cc | 36 ++--
gcc/config/rs6000/rs6000.h | 10 ++-
gcc/config/rs6000/rs6000.md | 24 ++--
gcc/testsuite/gcc.target/powerpc/pr118541.c | 43 -
6 files changed, 23 insertions(+), 104 deletions(-)
diff --git a/gcc/config/rs6000/predicates.md b/gcc/config/rs6000/predicates.md
index 700b266b62f5..647e89afb6a7 100644
--- a/gcc/config/rs6000/predicates.md
+++ b/gcc/config/rs6000/predicates.md
@@ -1465,13 +1465,9 @@
;; Return 1 if OP is a comparison operator suitable for vector/scalar
;; comparisons that generate a 0/-1 mask (i.e. the inverse of
-;; fpmask_comparison_operator). Do not allow UNLT and UNLE unless fast math is
-;; used since the power9 compare and mask instructions will raise an exception
-;; if one of the arguments is a signalling NaN.
+;; fpmask_comparison_operator).
(define_predicate "invert_fpmask_comparison_operator"
- (ior (match_code "ne")
- (and (match_code "unlt,unle")
- (match_test "!HONOR_NANS (DFmode)"
+ (match_code "ne,unlt,unle"))
;; Return 1 if OP is a comparison operation suitable for integer vector/scalar
;; comparisons that generate a -1/0 mask.
diff --git a/gcc/config/rs6000/rs6000-protos.h
b/gcc/config/rs6000/rs6000-protos.h
index 112332660d3b..4619142d197b 100644
--- a/gcc/config/rs6000/rs6000-protos.h
+++ b/gcc/config/rs6000/rs6000-protos.h
@@ -114,12 +114,8 @@ extern const char *rs6000_sibcall_template (rtx *,
unsigned int);
extern const char *rs6000_indirect_call_template (rtx *, unsigned int);
extern const char *rs6000_indirect_sibcall_template (rtx *, unsigned int);
extern const char *rs6000_pltseq_template (rtx *, int);
-
-#define REVERSE_COND_ORDERED_OKfalse
-#define REVERSE_COND_NO_ORDEREDtrue
-
extern enum rtx_code rs6000_reverse_condition (machine_mode,
- enum rtx_code, bool);
+ enum rtx_code);
extern rtx rs6000_emit_eqne (machine_mode, rtx, rtx, rtx);
extern rtx rs6000_emit_fp_cror (rtx_code, machine_mode, rtx);
extern void rs6000_emit_sCOND (machine_mode, rtx[]);
diff --git a/gcc/config/rs6000/rs6000.cc b/gcc/config/rs6000/rs6000.cc
index 60a239669c49..f9f9a0b931db 100644
--- a/gcc/config/rs6000/rs6000.cc
+++ b/gcc/config/rs6000/rs6000.cc
@@ -15360,32 +15360,17 @@ rs6000_print_patchable_function_entry (FILE *file,
}
enum rtx_code
-rs6000_reverse_condition (machine_mode cc_mode,
- enum rtx_code code,
- bool no_ordered)
+rs6000_reverse_condition (machine_mode mode, enum rtx_code code)
{
/* Reversal of FP compares takes care -- an ordered compare
- becomes an unordered compare and vice versa.
-
- However, this is not safe for ordered comparisons (i.e. for isgreater,
- etc.) and we are running in normal mode that supports NaNs starting with
- the power9. This is because ifcvt.cc will want to create a fp cmove, and
- the x{s,v}cmp{eq,gt,ge}{dp,qp} instructions will trap if one of the
- arguments is a signalling NaN.
-
- The mode passed is the condition code mode (i.e. CCmode, CCEQmode,
- CCFPmode, etc.) and not the mode of the original type, so for floating
- point just check whether NaNs are supported for DFmode. */
-
- if (HONOR_NANS (DFmode) && no_ordered
- && (code == UNLT || code == UNLE || code == UNGT || code == UNGE
+ becomes an unordered compare and vice versa. */
+ if (mode == CCFPmode
+ && (!flag_finite_math_only
+ || code == UNLT || code == UNLE || code == UNGT || code == UNGE
|| code == UNEQ || code == LTGT))
-return UNKNOWN;
-
- if (cc_mode == CCFPmode && !HONOR_NANS (DFmode))
return reverse_condition_maybe_unordered (code);
-
- return reverse_condition (code);
+ else
+return reverse_condition (code);
}
/* Check if C (as 64bit integer) can be rotated to a constant which constains
@@ -15995,14 +15980,11 @@ rs6000_emit_sCOND (machine_mode mode, rtx operands[])
rtx not_result = gen_reg_rtx (CCEQmode);
rtx not_op, rev_cond_rtx;
machine_mode cc_mode;
- enum rtx_code rev;
cc_mode = GET_MODE (XEXP (condition_rtx, 0));
- rev = rs6000_reverse_condition (cc_mode, cond_code,
- REVERSE_COND_ORDERED_OK);
- rev_cond_rtx = gen_rtx_fmt_ee (rev, SImode, XEXP (condition_rtx, 0),
-const0_rtx);
+ rev_cond_rtx = gen_rtx_fmt_ee (rs6000_reverse_condition (cc_mode,
cond_code),
+SImod
[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] Correction régression allocated_4.f90
https://gcc.gnu.org/g:ff1a370b3cb3f539f5b14845d67cea882959e94c commit ff1a370b3cb3f539f5b14845d67cea882959e94c Author: Mikael Morin Date: Thu Feb 6 17:31:49 2025 +0100 Correction régression allocated_4.f90 Diff: --- gcc/fortran/trans-array.cc | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc index afec6dcc45cb..2cca5e211469 100644 --- a/gcc/fortran/trans-array.cc +++ b/gcc/fortran/trans-array.cc @@ -1617,7 +1617,7 @@ gfc_conv_shift_descriptor (stmtblock_t *block, tree dest, tree src, tree tmp = gfc_conv_descriptor_data_get (src); gfc_conv_descriptor_data_set (block, dest, tmp); - tree offset_var = gfc_create_var (TREE_TYPE (tmp), "offset"); + tree offset_var = gfc_create_var (gfc_array_index_type, "offset"); gfc_add_modify (block, offset_var, gfc_index_zero_node); for (int n = 0 ; n < rank; n++)
[gcc r15-7390] AVR: Add support for a Compact Vector Table (-mcvt).
https://gcc.gnu.org/g:cb27337f9f4956e6eb634b26a7999ea68063f58a
commit r15-7390-gcb27337f9f4956e6eb634b26a7999ea68063f58a
Author: Georg-Johann Lay
Date: Thu Feb 6 11:28:28 2025 +0100
AVR: Add support for a Compact Vector Table (-mcvt).
Some AVR devices support a CVT:
- Devices from the 0-series, 1-series, 2-series.
- AVR16, AVR32, AVR64, AVR128 devices.
The support is provided by means of a startup code file
crt-cvt.o from AVR-LibC v2.3 that can be linked instead
of the traditional crt.o.
This patch adds a new command line option -mcvt that links
that CVT startup code (or issues an error when the device
doesn't support a CVT).
PR target/118764
gcc/
* config/avr/avr.opt (-mcvt): New target option.
* config/avr/avr-arch.h (AVR_CVT): New enum value.
* config/avr/avr-mcus.def: Add AVR_CVT flag for devices that
support it.
* config/avr/avr.cc (avr_handle_isr_attribute) [TARGET_CVT]: Issue
an error when a vector number larger that 3 is used.
* config/avr/gen-avr-mmcu-specs.cc (McuInfo.have_cvt): New property.
(print_mcu) <*avrlibc_startfile>: Use crt-cvt.o depending
on -mcvt (or issue an error when the device doesn't support a CVT).
* doc/invoke.texi (AVR Options): Document -mcvt.
Diff:
---
gcc/config/avr/avr-arch.h| 22 +++-
gcc/config/avr/avr-mcus.def | 212 +--
gcc/config/avr/avr.cc| 9 +-
gcc/config/avr/avr.opt | 4 +
gcc/config/avr/gen-avr-mmcu-specs.cc | 12 +-
gcc/doc/invoke.texi | 19 +++-
6 files changed, 160 insertions(+), 118 deletions(-)
diff --git a/gcc/config/avr/avr-arch.h b/gcc/config/avr/avr-arch.h
index b5b3606c0d12..efd7b1465746 100644
--- a/gcc/config/avr/avr-arch.h
+++ b/gcc/config/avr/avr-arch.h
@@ -158,6 +158,14 @@ AVR_ERRATA_SKIP
http://www.atmel.com/dyn/resources/prod_documents/doc2494.pdf
http://www.atmel.com/dyn/resources/prod_documents/doc1436.pdf
+AVR_CVT
+ The device supports a CVT (Compact Vector Table) which can be selected
+ with -mcvt, which links startup-code crt-cvt.o instead of the
+ usual crt.o. This assumes that AVR-LibC implements Issue #1010.
+https://github.com/avrdudes/avr-libc/issues/1010
+ crt-cvt.o also pulls in __do_cvt_init from lib.a which sets
+ bit CPUINT_CTRLA.CPUINT_CVT in order to activate the CVT.
+
AVR_ISA_RCALL
Always use RJMP / RCALL and assume JMP / CALL are not available.
This affects multilib selection via specs generation and -mshort-calls.
@@ -198,14 +206,16 @@ AVR_ISA_FLMAP
enum avr_device_specific_features
{
AVR_ISA_NONE,
- AVR_ISA_RMW = 0x1, /* device has RMW instructions. */
+ AVR_CVT = 0x1, /* Device supports a "Compact Vector Table" (-mcvt)
+ as configured in field CPUINT_CTRLA.CPUINT_CVT. */
AVR_SHORT_SP= 0x2, /* Stack Pointer has 8 bits width. */
- AVR_ERRATA_SKIP = 0x4, /* device has a core erratum. */
- AVR_ISA_LDS = 0x8, /* whether LDS / STS is valid for all data in static
- storage. Only useful for reduced Tiny. */
- AVR_ISA_RCALL = 0x10, /* Use RJMP / RCALL even though JMP / CALL
+ AVR_ERRATA_SKIP = 0x4, /* Device has a core erratum. */
+ AVR_ISA_RMW = 0x8, /* Device has RMW instructions. */
+ AVR_ISA_LDS = 0x10, /* Whether LDS / STS is valid for all data in static
+storage. Only useful for reduced Tiny. */
+ AVR_ISA_RCALL = 0x20, /* Use RJMP / RCALL even though JMP / CALL
are available (-mshort-calls). */
- AVR_ISA_FLMAP = 0x20 /* Has NVMCTRL_CTRLB.FLMAP to select which 32
KiB
+ AVR_ISA_FLMAP = 0x40 /* Has NVMCTRL_CTRLB.FLMAP to select which 32
KiB
block of program memory is visible in the RAM
address space. */
};
diff --git a/gcc/config/avr/avr-mcus.def b/gcc/config/avr/avr-mcus.def
index b717749b67ad..9f79a9a45795 100644
--- a/gcc/config/avr/avr-mcus.def
+++ b/gcc/config/avr/avr-mcus.def
@@ -49,7 +49,7 @@
ARCHSpecifies the multilib variant together with AVR_SHORT_SP
ATTRSpecifies the device specific features
- - additional ISA, short SP, errata skip etc.,
+ - additional ISA, short SP, errata skip etc., see avr-arch.h
MACRO If NULL, this is a core and not a device. If non-NULL,
supply respective built-in macro.
@@ -309,104 +309,104 @@ AVR_MCU ("atxmega16c4", ARCH_AVRXMEGA2,
AVR_ISA_RMW, "__AVR_ATxmega16C4__"
AVR_MCU ("atxmega32a4u", ARCH_AVRXMEGA2, AVR_ISA_RMW,
"__AVR_ATxmega32A4U__", 0x2000, 0x0, 0x9000, 0)
AVR_MCU ("atxmega32c4", ARCH_AVRXMEGA2, AVR_ISA_RMW,
"__AVR_ATxmega32C4__", 0x2000, 0x0, 0x9000, 0)
AVR_MCU
[gcc r15-7403] [testsuite] [sparc] skip tls tests if emulated
https://gcc.gnu.org/g:d1061212e4a57bd68dcfdf711e509f71c9bbbce3
commit r15-7403-gd1061212e4a57bd68dcfdf711e509f71c9bbbce3
Author: Alexandre Oliva
Date: Fri Feb 7 04:14:39 2025 -0300
[testsuite] [sparc] skip tls tests if emulated
A number of tls tests expect TLS-specific relocations, that are not
present when tls is emulated, as on e.g. leon3-elf. Skip the tests
when tls is emulated.
for gcc/testsuite/ChangeLog
* gcc.target/sparc/tls-ld-int16.c: Skip when tls is emulated.
* gcc.target/sparc/tls-ld-int32.c: Likewise.
* gcc.target/sparc/tls-ld-int8.c: Likewise.
* gcc.target/sparc/tls-ld-uint16.c: Likewise.
* gcc.target/sparc/tls-ld-uint32.c: Likewise.
* gcc.target/sparc/tls-ld-uint8.c: Likewise.
Diff:
---
gcc/testsuite/gcc.target/sparc/tls-ld-int16.c | 1 +
gcc/testsuite/gcc.target/sparc/tls-ld-int32.c | 1 +
gcc/testsuite/gcc.target/sparc/tls-ld-int8.c | 1 +
gcc/testsuite/gcc.target/sparc/tls-ld-uint16.c | 1 +
gcc/testsuite/gcc.target/sparc/tls-ld-uint32.c | 1 +
gcc/testsuite/gcc.target/sparc/tls-ld-uint8.c | 1 +
6 files changed, 6 insertions(+)
diff --git a/gcc/testsuite/gcc.target/sparc/tls-ld-int16.c
b/gcc/testsuite/gcc.target/sparc/tls-ld-int16.c
index d3d28086156e..de4ce4034c6d 100644
--- a/gcc/testsuite/gcc.target/sparc/tls-ld-int16.c
+++ b/gcc/testsuite/gcc.target/sparc/tls-ld-int16.c
@@ -1,6 +1,7 @@
/* { dg-do compile } */
/* { dg-options "-O2" }
/* { dg-add-options tls } */
+/* { dg-skip-if "native tls expected" { tls_emulated } } */
#include
diff --git a/gcc/testsuite/gcc.target/sparc/tls-ld-int32.c
b/gcc/testsuite/gcc.target/sparc/tls-ld-int32.c
index cf18147ef727..5604c24151ac 100644
--- a/gcc/testsuite/gcc.target/sparc/tls-ld-int32.c
+++ b/gcc/testsuite/gcc.target/sparc/tls-ld-int32.c
@@ -1,6 +1,7 @@
/* { dg-do compile } */
/* { dg-options "-O2" }
/* { dg-add-options tls } */
+/* { dg-skip-if "native tls expected" { tls_emulated } } */
#include
diff --git a/gcc/testsuite/gcc.target/sparc/tls-ld-int8.c
b/gcc/testsuite/gcc.target/sparc/tls-ld-int8.c
index a07cffc37f8c..17eb32ea2a10 100644
--- a/gcc/testsuite/gcc.target/sparc/tls-ld-int8.c
+++ b/gcc/testsuite/gcc.target/sparc/tls-ld-int8.c
@@ -1,6 +1,7 @@
/* { dg-do compile } */
/* { dg-options "-O2" }
/* { dg-add-options tls } */
+/* { dg-skip-if "native tls expected" { tls_emulated } } */
#include
diff --git a/gcc/testsuite/gcc.target/sparc/tls-ld-uint16.c
b/gcc/testsuite/gcc.target/sparc/tls-ld-uint16.c
index 41ee687b28c5..81990a7bf3ca 100644
--- a/gcc/testsuite/gcc.target/sparc/tls-ld-uint16.c
+++ b/gcc/testsuite/gcc.target/sparc/tls-ld-uint16.c
@@ -1,6 +1,7 @@
/* { dg-do compile } */
/* { dg-options "-O2" }
/* { dg-add-options tls } */
+/* { dg-skip-if "native tls expected" { tls_emulated } } */
#include
diff --git a/gcc/testsuite/gcc.target/sparc/tls-ld-uint32.c
b/gcc/testsuite/gcc.target/sparc/tls-ld-uint32.c
index 9c7915372b9e..60524ba87cf6 100644
--- a/gcc/testsuite/gcc.target/sparc/tls-ld-uint32.c
+++ b/gcc/testsuite/gcc.target/sparc/tls-ld-uint32.c
@@ -1,6 +1,7 @@
/* { dg-do compile } */
/* { dg-options "-O2" }
/* { dg-add-options tls } */
+/* { dg-skip-if "native tls expected" { tls_emulated } } */
#include
diff --git a/gcc/testsuite/gcc.target/sparc/tls-ld-uint8.c
b/gcc/testsuite/gcc.target/sparc/tls-ld-uint8.c
index 0dcff66eb15e..7a7492197f95 100644
--- a/gcc/testsuite/gcc.target/sparc/tls-ld-uint8.c
+++ b/gcc/testsuite/gcc.target/sparc/tls-ld-uint8.c
@@ -1,6 +1,7 @@
/* { dg-do compile } */
/* { dg-options "-O2" }
/* { dg-add-options tls } */
+/* { dg-skip-if "native tls expected" { tls_emulated } } */
#include
[gcc r15-7404] [testsuite] [sparc] select ultrasparc for fsmuld test
https://gcc.gnu.org/g:7722b65f877f5c6dccea56a711d75e2baedba5cb
commit r15-7404-g7722b65f877f5c6dccea56a711d75e2baedba5cb
Author: Alexandre Oliva
Date: Fri Feb 7 04:14:44 2025 -0300
[testsuite] [sparc] select ultrasparc for fsmuld test
vis3move-3.c expects fsmuld, that is not available on all variants of
sparc. Select a cpu that supports it for the test.
Now, -mfix-ut699 irrevocbly disables fsmuld, so skip the test if the
test configuration uses that option.
for gcc/testsuite/ChangeLog
* gcc.target/sparc/vis3move-3.c: Select ultrasparc. Skip with
-mfix-ut699.
Diff:
---
gcc/testsuite/gcc.target/sparc/vis3move-3.c | 3 ++-
1 file changed, 2 insertions(+), 1 deletion(-)
diff --git a/gcc/testsuite/gcc.target/sparc/vis3move-3.c
b/gcc/testsuite/gcc.target/sparc/vis3move-3.c
index 3b2116eec0cb..f32ca918bac9 100644
--- a/gcc/testsuite/gcc.target/sparc/vis3move-3.c
+++ b/gcc/testsuite/gcc.target/sparc/vis3move-3.c
@@ -1,6 +1,7 @@
/* { dg-do compile } */
/* { dg-require-effective-target ilp32 } */
-/* { dg-options "-O1 -mvis3" } */
+/* { dg-skip-if "prevents fsmuld" { *-*-* } { "-mfix-ut699" } { "" } } */
+/* { dg-options "-O1 -mvis3 -mcpu=ultrasparc" } */
float fnegs (float a)
{
[gcc r15-7401] [testsuite] [sparc] use -mtune in alignment tuning test
https://gcc.gnu.org/g:670f83c0b9f50e54b082ad566049f812fe47ae65
commit r15-7401-g670f83c0b9f50e54b082ad566049f812fe47ae65
Author: Alexandre Oliva
Date: Fri Feb 7 04:10:57 2025 -0300
[testsuite] [sparc] use -mtune in alignment tuning test
If -mcpu=leon3 is present in the command line for a test run,
overriding it with -mcpu=niagara7 is not enough to override the tuning
for leon3 selected by the previous -mcpu option.
niagara7-align.c tests for niagara7 alignment tuning, so use -mtune
rather than -mcpu.
for gcc/testsuite/ChangeLog
* gcc.target/sparc/niagara7-align.c: Use -mtune.
Diff:
---
gcc/testsuite/gcc.target/sparc/niagara7-align.c | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/gcc/testsuite/gcc.target/sparc/niagara7-align.c
b/gcc/testsuite/gcc.target/sparc/niagara7-align.c
index a46aac17c329..01a8cb621d5c 100644
--- a/gcc/testsuite/gcc.target/sparc/niagara7-align.c
+++ b/gcc/testsuite/gcc.target/sparc/niagara7-align.c
@@ -1,4 +1,4 @@
/* { dg-do compile } */
-/* { dg-options "-falign-functions -mcpu=niagara7" } */
+/* { dg-options "-falign-functions -mtune=niagara7" } */
/* { dg-final { scan-assembler "\.align 64" } } */
void foo(void) {}
[gcc r15-7402] [testsuite] [sparc] skip sparc-ret-1 with -mfix-ut699
https://gcc.gnu.org/g:9a551d634fdfe8ad432a9a8a2d4621997137a231
commit r15-7402-g9a551d634fdfe8ad432a9a8a2d4621997137a231
Author: Alexandre Oliva
Date: Fri Feb 7 04:12:52 2025 -0300
[testsuite] [sparc] skip sparc-ret-1 with -mfix-ut699
Option -mfix-ut699 changes the set of instructions that can be placed
in the delay slot, preventing the expected insn placement. Skip the
test if the option is present.
for gcc/testsuite/ChangeLog
* gcc.target/sparc/sparc-ret-1.c: Skip on -mfix-ut699.
Diff:
---
gcc/testsuite/gcc.target/sparc/sparc-ret-1.c | 1 +
1 file changed, 1 insertion(+)
diff --git a/gcc/testsuite/gcc.target/sparc/sparc-ret-1.c
b/gcc/testsuite/gcc.target/sparc/sparc-ret-1.c
index 808e8a98f0e8..ef459c5016e9 100644
--- a/gcc/testsuite/gcc.target/sparc/sparc-ret-1.c
+++ b/gcc/testsuite/gcc.target/sparc/sparc-ret-1.c
@@ -1,5 +1,6 @@
/* { dg-do compile } */
/* { dg-skip-if "no register windows" { *-*-* } { "-mflat" } { "" } } */
+/* { dg-skip-if "prevents expected asm" { *-*-* } { "-mfix-ut699" } { "" } } */
/* { dg-require-effective-target ilp32 } */
/* { dg-options "-mcpu=ultrasparc -O" } */
[gcc/aoliva/heads/testme] (110 commits) [ifcombine] avoid creating out-of-bounds BIT_FIELD_REFs [PR
The branch 'aoliva/heads/testme' was updated to point to:
8c59c0b700c5... [ifcombine] avoid creating out-of-bounds BIT_FIELD_REFs [PR
It previously pointed to:
c936fd0eb997... [testsuite] [sparc] select ultrasparc for fsmuld test
Diff:
!!! WARNING: THE FOLLOWING COMMITS ARE NO LONGER ACCESSIBLE (LOST):
---
c936fd0... [testsuite] [sparc] select ultrasparc for fsmuld test
8da3444... [testsuite] [sparc] skip sparc-ret-1 with -mfix-ut699
20c5853... [testsuite] [sparc] use -mtune in alignment tuning test
144fef6... [testsuite] tolerate later success [PR108357]
ea14d0a... [testsuite] [sparc] skip tls tests if emulated
Summary of changes (added commits):
---
8c59c0b... [ifcombine] avoid creating out-of-bounds BIT_FIELD_REFs [PR
eaf4808... [testsuite] tolerate later success [PR108357]
7722b65... [testsuite] [sparc] select ultrasparc for fsmuld test (*)
d106121... [testsuite] [sparc] skip tls tests if emulated (*)
9a551d6... [testsuite] [sparc] skip sparc-ret-1 with -mfix-ut699 (*)
670f83c... [testsuite] [sparc] use -mtune in alignment tuning test (*)
d3ff498... ira: Add a target hook for callee-saved register cost scale (*)
5378627... Daily bump. (*)
ba58506... [PATCH] RISC-V: Move UNSPEC_SSP_SET and UNSPEC_SSP_TEST to (*)
33e6101... [RISC-V] Fix risc-v expected test output after recent iv ch (*)
a69b728... avr.opt.urls += -mcvt (*)
8d19fbb... middle-end: Remove unused internal function after IVopts cl (*)
cfed997... Fortran: Fix handling of the X edit descriptor. (*)
6305c46... c++: Add no_unique_address attribute further test coverage (*)
122b946... c++: Add noreturn attribute further test coverage [PR110345 (*)
7169ee0... c++: Add nodiscard attribute further test coverage [PR11034 (*)
cb27337... AVR: Add support for a Compact Vector Table (-mcvt). (*)
a03303b... Fortran: FIx ICE in associate with elemental function [PR1 (*)
bb9cee8... loop-iv, riscv: Fix get_biv_step_1 for RISC-V [PR117506] (*)
5282e13... AVR: genmultilib.awk - Use more robust parsing of spaces. (*)
50d2bde... LoongArch: Fix ICE caused by illegal calls to builtin funct (*)
7eb260c... vect: Move induction IV increments [PR110449] (*)
677122c... rtl-optimization/117922 - disable fold-mem-offsets for high (*)
927e10b... tree-optimization/118749 - bogus alignment peeling causes m (*)
9a409f5... Daily bump. (*)
3e08a4e... [committed] Disable ABS instruction on bfin port (*)
198f4df... c++: Reject default arguments for template class friend fun (*)
9854544... [PR115568][LRA]: Use more strict output reload check in rem (*)
0006c07... go: update builtin function attributes (*)
50a31b6... aarch64: Fix sve/acle/general/ldff1_8.c failures (*)
6f95af4... Fortran/OpenMP: Add location data to 'sorry' [PR118740] (*)
6094801... cselib: Fix up previous patch for SPARC [PR117239] (*)
886ce97... cselib: For CALL_INSNs to const/pure fns invalidate memory (*)
5163cf2... arm: Use POP {pc} to return when returning [PR118089] (*)
b47c7a5... arm: remove constraints from *pop_multiple_with_writeback_a (*)
aead1d4... arm: cleanup code in ldm_stm_operation_p; relax limits on l (*)
da88e70... vect: Fix wrong code with pr108692.c on targets with only n (*)
754137d... testsuite: Revert to the original version of pr100056.c (*)
6b49883... libstdc++: Fix gnu.ver CXXABI_1.3.16 for Solaris [PR118701] (*)
884893a... MAINTAINERS: Add myself to write after approval (*)
3a58827... fortran/trans-openmp.cc: Use the correct member in gfc_omp_ (*)
e41a5a2... Fortran: Fix PR 47485. (*)
f2a8f3c... RTEMS: Add Cortex-M33 multilib (*)
432f988... Daily bump. (*)
4d0faaa... PR modula2/115112 Incorrect line debugging information occu (*)
f176028... c++: add fixed test [PR94100] (*)
a64d9c9... c++: Fix ICE with #embed/RAW_DATA_CST after list conversion (*)
64c66f5... Ada: Fix assertion failure with iterator in container aggre (*)
88c9c4a... testsuite: RISC-V: Ignore pr118170.c for E ABI (*)
a506abf... Fix file cache tunables documentation (*)
bcd3886... arm: testsuite: Adapt mve-vabs.c to improved codegen (*)
e6e40cb... c++: auto in trailing-return-type in parameter [PR117778] (*)
53d1f6c... c++: bogus -Wvexing-parse with trailing-return-type [PR1187 (*)
adf1da7... testsuite: XFAIL test in pr109393.c for ilp32 targets [PR11 (*)
4c8c9c9... c/118742 - gimple FE parsing of unary operators of C promot (*)
a2e0a30... IBM zSystems: Do not use @PLT with larl (*)
d346af2... c++: Fix overeager Woverloaded-virtual with conversion oper (*)
0675eb1... tree-optimization/117113 - ICE with unroll-and-jam (*)
887bdab... c++: Properly detect calls to digest_init in build_vec_init (*)
4b2726a... c++: Fix up pedwarn for capturing structured bindings in la (*)
4c98b38... optabs: Fix widening optabs for vec-mode -> scalar-mode [PR (*)
c2a0ee5... Add modular exponentiation for
[gcc/aoliva/heads/testbase] (108 commits) [testsuite] [sparc] select ultrasparc for fsmuld test
The branch 'aoliva/heads/testbase' was updated to point to:
7722b65f877f... [testsuite] [sparc] select ultrasparc for fsmuld test
It previously pointed to:
dd5978b2f008... [testsuite] require profiling support [PR113689]
Diff:
Summary of changes (added commits):
---
7722b65... [testsuite] [sparc] select ultrasparc for fsmuld test (*)
d106121... [testsuite] [sparc] skip tls tests if emulated (*)
9a551d6... [testsuite] [sparc] skip sparc-ret-1 with -mfix-ut699 (*)
670f83c... [testsuite] [sparc] use -mtune in alignment tuning test (*)
d3ff498... ira: Add a target hook for callee-saved register cost scale (*)
5378627... Daily bump. (*)
ba58506... [PATCH] RISC-V: Move UNSPEC_SSP_SET and UNSPEC_SSP_TEST to (*)
33e6101... [RISC-V] Fix risc-v expected test output after recent iv ch (*)
a69b728... avr.opt.urls += -mcvt (*)
8d19fbb... middle-end: Remove unused internal function after IVopts cl (*)
cfed997... Fortran: Fix handling of the X edit descriptor. (*)
6305c46... c++: Add no_unique_address attribute further test coverage (*)
122b946... c++: Add noreturn attribute further test coverage [PR110345 (*)
7169ee0... c++: Add nodiscard attribute further test coverage [PR11034 (*)
cb27337... AVR: Add support for a Compact Vector Table (-mcvt). (*)
a03303b... Fortran: FIx ICE in associate with elemental function [PR1 (*)
bb9cee8... loop-iv, riscv: Fix get_biv_step_1 for RISC-V [PR117506] (*)
5282e13... AVR: genmultilib.awk - Use more robust parsing of spaces. (*)
50d2bde... LoongArch: Fix ICE caused by illegal calls to builtin funct (*)
7eb260c... vect: Move induction IV increments [PR110449] (*)
677122c... rtl-optimization/117922 - disable fold-mem-offsets for high (*)
927e10b... tree-optimization/118749 - bogus alignment peeling causes m (*)
9a409f5... Daily bump. (*)
3e08a4e... [committed] Disable ABS instruction on bfin port (*)
198f4df... c++: Reject default arguments for template class friend fun (*)
9854544... [PR115568][LRA]: Use more strict output reload check in rem (*)
0006c07... go: update builtin function attributes (*)
50a31b6... aarch64: Fix sve/acle/general/ldff1_8.c failures (*)
6f95af4... Fortran/OpenMP: Add location data to 'sorry' [PR118740] (*)
6094801... cselib: Fix up previous patch for SPARC [PR117239] (*)
886ce97... cselib: For CALL_INSNs to const/pure fns invalidate memory (*)
5163cf2... arm: Use POP {pc} to return when returning [PR118089] (*)
b47c7a5... arm: remove constraints from *pop_multiple_with_writeback_a (*)
aead1d4... arm: cleanup code in ldm_stm_operation_p; relax limits on l (*)
da88e70... vect: Fix wrong code with pr108692.c on targets with only n (*)
754137d... testsuite: Revert to the original version of pr100056.c (*)
6b49883... libstdc++: Fix gnu.ver CXXABI_1.3.16 for Solaris [PR118701] (*)
884893a... MAINTAINERS: Add myself to write after approval (*)
3a58827... fortran/trans-openmp.cc: Use the correct member in gfc_omp_ (*)
e41a5a2... Fortran: Fix PR 47485. (*)
f2a8f3c... RTEMS: Add Cortex-M33 multilib (*)
432f988... Daily bump. (*)
4d0faaa... PR modula2/115112 Incorrect line debugging information occu (*)
f176028... c++: add fixed test [PR94100] (*)
a64d9c9... c++: Fix ICE with #embed/RAW_DATA_CST after list conversion (*)
64c66f5... Ada: Fix assertion failure with iterator in container aggre (*)
88c9c4a... testsuite: RISC-V: Ignore pr118170.c for E ABI (*)
a506abf... Fix file cache tunables documentation (*)
bcd3886... arm: testsuite: Adapt mve-vabs.c to improved codegen (*)
e6e40cb... c++: auto in trailing-return-type in parameter [PR117778] (*)
53d1f6c... c++: bogus -Wvexing-parse with trailing-return-type [PR1187 (*)
adf1da7... testsuite: XFAIL test in pr109393.c for ilp32 targets [PR11 (*)
4c8c9c9... c/118742 - gimple FE parsing of unary operators of C promot (*)
a2e0a30... IBM zSystems: Do not use @PLT with larl (*)
d346af2... c++: Fix overeager Woverloaded-virtual with conversion oper (*)
0675eb1... tree-optimization/117113 - ICE with unroll-and-jam (*)
887bdab... c++: Properly detect calls to digest_init in build_vec_init (*)
4b2726a... c++: Fix up pedwarn for capturing structured bindings in la (*)
4c98b38... optabs: Fix widening optabs for vec-mode -> scalar-mode [PR (*)
c2a0ee5... Add modular exponentiation for UNSIGNED. (*)
5b46c01... rtl-optimization/117611 - ICE in simplify_shift_const_1 (*)
a55e14b... lto/113207 - fix free_lang_data_in_type (*)
d3627c7... c++: Improve contracts support in modules [PR108205] (*)
736e8ee... c++: Modularise start_cleanup_fn [PR98893] (*)
a5b54be... Daily bump. (*)
26d3424... c++: find A pack from B in ...B> [PR1 (*)
4c74379... c++/coroutines: Fix awaiter var creation [PR116506] (*)
ec716ad... c++: coroutines and range for [PR118491] (*)
f3a41e6... Fortran: different character lengths in array constructor [ (*)
214224c... i386: Fix and improve TARG
[gcc(refs/users/aoliva/heads/testme)] [ifcombine] avoid creating out-of-bounds BIT_FIELD_REFs [PR118514]
https://gcc.gnu.org/g:8c59c0b700c58df2692471166fcfb1012a4d432b
commit 8c59c0b700c58df2692471166fcfb1012a4d432b
Author: Alexandre Oliva
Date: Fri Feb 7 04:14:52 2025 -0300
[ifcombine] avoid creating out-of-bounds BIT_FIELD_REFs [PR118514]
If decode_field_reference finds a load that accesses past the inner
object's size, bail out.
Drop the too-strict assert.
for gcc/ChangeLog
PR tree-optimization/118514
PR tree-optimization/118706
* gimple-fold.cc (decode_field_reference): Refuse to consider
merging out-of-bounds BIT_FIELD_REFs.
(make_bit_field_load): Drop too-strict assert.
* tree-eh.cc (bit_field_ref_in_bounds_p): Rename to...
(access_in_bounds_of_type_p): ... this. Change interface,
export.
(tree_could_trap_p): Adjust.
* tree-eh.h (access_in_bounds_of_type_p): Declare.
for gcc/testsuite/ChangeLog
PR tree-optimization/118514
PR tree-optimization/118706
* gcc.dg/field-merge-25.c: New.
Diff:
---
gcc/gimple-fold.cc| 11 ++-
gcc/testsuite/gcc.dg/field-merge-25.c | 15 +++
gcc/tree-eh.cc| 25 +
gcc/tree-eh.h | 1 +
4 files changed, 31 insertions(+), 21 deletions(-)
diff --git a/gcc/gimple-fold.cc b/gcc/gimple-fold.cc
index 45485782cdf9..29191685a43c 100644
--- a/gcc/gimple-fold.cc
+++ b/gcc/gimple-fold.cc
@@ -7686,10 +7686,8 @@ decode_field_reference (tree *pexp, HOST_WIDE_INT
*pbitsize,
|| bs <= shiftrt
|| offset != 0
|| TREE_CODE (inner) == PLACEHOLDER_EXPR
- /* Reject out-of-bound accesses (PR79731). */
- || (! AGGREGATE_TYPE_P (TREE_TYPE (inner))
- && compare_tree_int (TYPE_SIZE (TREE_TYPE (inner)),
- bp + bs) < 0)
+ /* Reject out-of-bound accesses (PR79731, PR118514). */
+ || !access_in_bounds_of_type_p (TREE_TYPE (inner), bs, bp)
|| (INTEGRAL_TYPE_P (TREE_TYPE (inner))
&& !type_has_mode_precision_p (TREE_TYPE (inner
return NULL_TREE;
@@ -7859,11 +7857,6 @@ make_bit_field_load (location_t loc, tree inner, tree
orig_inner, tree type,
gimple *new_stmt = gsi_stmt (i);
if (gimple_has_mem_ops (new_stmt))
gimple_set_vuse (new_stmt, reaching_vuse);
- gcc_checking_assert (! (gimple_assign_load_p (point)
- && gimple_assign_load_p (new_stmt))
- || (tree_could_trap_p (gimple_assign_rhs1 (point))
- == tree_could_trap_p (gimple_assign_rhs1
-(new_stmt;
}
gimple_stmt_iterator gsi = gsi_for_stmt (point);
diff --git a/gcc/testsuite/gcc.dg/field-merge-25.c
b/gcc/testsuite/gcc.dg/field-merge-25.c
new file mode 100644
index ..e769b0ae7b84
--- /dev/null
+++ b/gcc/testsuite/gcc.dg/field-merge-25.c
@@ -0,0 +1,15 @@
+/* { dg-do compile } */
+/* { dg-options "-O1 -fno-tree-fre" } */
+
+/* PR tree-optimization/118706 */
+
+int a[1][1][3], b;
+int main() {
+ int c = -1;
+ while (b) {
+if (a[c][c][6])
+ break;
+if (a[0][0][0])
+ break;
+ }
+}
diff --git a/gcc/tree-eh.cc b/gcc/tree-eh.cc
index 7015189a2de8..a4d59954c059 100644
--- a/gcc/tree-eh.cc
+++ b/gcc/tree-eh.cc
@@ -2646,24 +2646,22 @@ range_in_array_bounds_p (tree ref)
return true;
}
-/* Return true iff EXPR, a BIT_FIELD_REF, accesses a bit range that is known to
- be in bounds for the referred operand type. */
+/* Return true iff a BIT_FIELD_REF <(TYPE)???, SIZE, OFFSET> would access a bit
+ range that is known to be in bounds for TYPE. */
-static bool
-bit_field_ref_in_bounds_p (tree expr)
+bool
+access_in_bounds_of_type_p (tree type, poly_uint64 size, poly_uint64 offset)
{
- tree size_tree;
- poly_uint64 size_max, min, wid, max;
+ tree type_size_tree;
+ poly_uint64 type_size_max, min = offset, wid = size, max;
- size_tree = TYPE_SIZE (TREE_TYPE (TREE_OPERAND (expr, 0)));
- if (!size_tree || !poly_int_tree_p (size_tree, &size_max))
+ type_size_tree = TYPE_SIZE (type);
+ if (!type_size_tree || !poly_int_tree_p (type_size_tree, &type_size_max))
return false;
- min = bit_field_offset (expr);
- wid = bit_field_size (expr);
max = min + wid;
if (maybe_lt (max, min)
- || maybe_lt (size_max, max))
+ || maybe_lt (type_size_max, max))
return false;
return true;
@@ -2712,7 +2710,10 @@ tree_could_trap_p (tree expr)
switch (code)
{
case BIT_FIELD_REF:
- if (DECL_P (TREE_OPERAND (expr, 0)) && !bit_field_ref_in_bounds_p (expr))
+ if (DECL_P (TREE_OPERAND (expr, 0))
+ && !access_in_bounds_of_type_p (TREE_TYPE (TREE_OPERAND (expr, 0)),
+ bit_field_size (expr),
+ bit_field_offset (e
[gcc(refs/users/aoliva/heads/testme)] [testsuite] tolerate later success [PR108357]
https://gcc.gnu.org/g:eaf4808e122b00e57a17e543d81cfa1720331d61
commit eaf4808e122b00e57a17e543d81cfa1720331d61
Author: Alexandre Oliva
Date: Fri Feb 7 04:14:48 2025 -0300
[testsuite] tolerate later success [PR108357]
On leon3-elf and presumably on other targets, the test fails due to
differences in calling conventions and other reasons, that add extra
gimple stmts that prevent the expected optimization at the expected
point. The optimization takes place anyway, just a little later, so
tolerate that.
for gcc/testsuite/ChangeLog
PR tree-optimization/108357
* gcc.dg/tree-ssa/pr108357.c: Tolerate later optimization.
Diff:
---
gcc/testsuite/gcc.dg/tree-ssa/pr108357.c | 7 +--
1 file changed, 5 insertions(+), 2 deletions(-)
diff --git a/gcc/testsuite/gcc.dg/tree-ssa/pr108357.c
b/gcc/testsuite/gcc.dg/tree-ssa/pr108357.c
index 44c457b7a977..7dff235f8927 100644
--- a/gcc/testsuite/gcc.dg/tree-ssa/pr108357.c
+++ b/gcc/testsuite/gcc.dg/tree-ssa/pr108357.c
@@ -1,5 +1,5 @@
/* { dg-do compile } */
-/* { dg-options "-O2 -fdump-tree-threadfull1" } */
+/* { dg-options "-O2 -fdump-tree-optimized" } */
static char b;
static unsigned c;
@@ -19,4 +19,7 @@ int main()
f(g);
}
-/* { dg-final { scan-tree-dump-not "foo" "threadfull1" } } */
+/* We expect threadfull1 to eliminate the call to foo(), but not all targets
+ manage that at that point. Calling conventions (mandatory promotion) play a
+ role, but there's more than that. */
+/* { dg-final { scan-tree-dump-not "foo" "optimized" } } */
[gcc r15-7398] [PATCH] RISC-V: Move UNSPEC_SSP_SET and UNSPEC_SSP_TEST to correct enum
https://gcc.gnu.org/g:ba585064781b58eef4667c0baa09b854f711aae4
commit r15-7398-gba585064781b58eef4667c0baa09b854f711aae4
Author: Craig Blackmore
Date: Thu Feb 6 12:56:26 2025 -0700
[PATCH] RISC-V: Move UNSPEC_SSP_SET and UNSPEC_SSP_TEST to correct enum
stack_protect_{set,test}_ were showing up in RTL dumps as
UNSPEC_COPYSIGN and UNSPEC_FMV_X_W due to UNSPEC_SSP_SET and
UNSPEC_SSP_TEST being put in the unspecv enum instead of unspec.
gcc/ChangeLog:
* config/riscv/riscv.md: Move UNSPEC_SSP_SET and UNSPEC_SSP_TEST
to unspec enum.
Diff:
---
gcc/config/riscv/riscv.md | 8
1 file changed, 4 insertions(+), 4 deletions(-)
diff --git a/gcc/config/riscv/riscv.md b/gcc/config/riscv/riscv.md
index 09053df1eb9b..f7070766783e 100644
--- a/gcc/config/riscv/riscv.md
+++ b/gcc/config/riscv/riscv.md
@@ -99,6 +99,10 @@
;; CRC unspecs
UNSPEC_CRC
UNSPEC_CRC_REV
+
+ ;; Stack Smash Protector
+ UNSPEC_SSP_SET
+ UNSPEC_SSP_TEST
])
(define_c_enum "unspecv" [
@@ -123,10 +127,6 @@
UNSPECV_FENCE
UNSPECV_FENCE_I
- ;; Stack Smash Protector
- UNSPEC_SSP_SET
- UNSPEC_SSP_TEST
-
;; CMO instructions.
UNSPECV_CLEAN
UNSPECV_FLUSH
[gcc r15-7400] ira: Add a target hook for callee-saved register cost scale
https://gcc.gnu.org/g:d3ff498c478acefce35de04402f99171b4f64a1a
commit r15-7400-gd3ff498c478acefce35de04402f99171b4f64a1a
Author: H.J. Lu
Date: Sun Feb 2 07:10:55 2025 +0800
ira: Add a target hook for callee-saved register cost scale
commit 3b9b8d6cfdf59337f4b7ce10ce92a98044b2657b
Author: Surya Kumari Jangala
Date: Tue Jun 25 08:37:49 2024 -0500
ira: Scale save/restore costs of callee save registers with block
frequency
scales the cost of saving/restoring a callee-save hard register in epilogue
and prologue with the entry block frequency, which, if not optimizing for
size, is 1, for all targets. As the result, callee-saved registers
may not be used to preserve local variable values across calls on some
targets, like x86. Add a target hook for the callee-saved register cost
scale in epilogue and prologue used by IRA. The default version of this
target hook returns 1 if optimizing for size, otherwise returns the entry
block frequency. Add an x86 version of this target hook to restore the
old behavior prior to the above commit.
PR rtl-optimization/111673
PR rtl-optimization/115932
PR rtl-optimization/116028
PR rtl-optimization/117081
PR rtl-optimization/117082
PR rtl-optimization/118497
* ira-color.cc (assign_hard_reg): Call the target hook for the
callee-saved register cost scale in epilogue and prologue.
* target.def (ira_callee_saved_register_cost_scale): New target
hook.
* targhooks.cc (default_ira_callee_saved_register_cost_scale):
New.
* targhooks.h (default_ira_callee_saved_register_cost_scale):
Likewise.
* config/i386/i386.cc (ix86_ira_callee_saved_register_cost_scale):
New.
(TARGET_IRA_CALLEE_SAVED_REGISTER_COST_SCALE): Likewise.
* doc/tm.texi: Regenerated.
* doc/tm.texi.in (TARGET_IRA_CALLEE_SAVED_REGISTER_COST_SCALE):
New.
Signed-off-by: H.J. Lu
Diff:
---
gcc/config/i386/i386.cc | 11 +++
gcc/doc/tm.texi | 8
gcc/doc/tm.texi.in | 2 ++
gcc/ira-color.cc| 3 +--
gcc/target.def | 12
gcc/targhooks.cc| 8
gcc/targhooks.h | 1 +
7 files changed, 43 insertions(+), 2 deletions(-)
diff --git a/gcc/config/i386/i386.cc b/gcc/config/i386/i386.cc
index f89201684a8a..3128973ba79c 100644
--- a/gcc/config/i386/i386.cc
+++ b/gcc/config/i386/i386.cc
@@ -20600,6 +20600,14 @@ ix86_class_likely_spilled_p (reg_class_t rclass)
return false;
}
+/* Implement TARGET_IRA_CALLEE_SAVED_REGISTER_COST_SCALE. */
+
+static int
+ix86_ira_callee_saved_register_cost_scale (int)
+{
+ return 1;
+}
+
/* Return true if a set of DST by the expression SRC should be allowed.
This prevents complex sets of likely_spilled hard regs before split1. */
@@ -27078,6 +27086,9 @@ ix86_libgcc_floating_mode_supported_p
#define TARGET_PREFERRED_OUTPUT_RELOAD_CLASS ix86_preferred_output_reload_class
#undef TARGET_CLASS_LIKELY_SPILLED_P
#define TARGET_CLASS_LIKELY_SPILLED_P ix86_class_likely_spilled_p
+#undef TARGET_IRA_CALLEE_SAVED_REGISTER_COST_SCALE
+#define TARGET_IRA_CALLEE_SAVED_REGISTER_COST_SCALE \
+ ix86_ira_callee_saved_register_cost_scale
#undef TARGET_VECTORIZE_BUILTIN_VECTORIZATION_COST
#define TARGET_VECTORIZE_BUILTIN_VECTORIZATION_COST \
diff --git a/gcc/doc/tm.texi b/gcc/doc/tm.texi
index 0de24eda6f01..9f42913a4efb 100644
--- a/gcc/doc/tm.texi
+++ b/gcc/doc/tm.texi
@@ -3047,6 +3047,14 @@ A target hook which can change allocno class for given
pseudo from
The default version of this target hook always returns given class.
@end deftypefn
+@deftypefn {Target Hook} int TARGET_IRA_CALLEE_SAVED_REGISTER_COST_SCALE (int
@var{hard_regno})
+A target hook which returns the callee-saved register @var{hard_regno}
+cost scale in epilogue and prologue used by IRA.
+
+The default version of this target hook returns 1 if optimizing for
+size, otherwise returns the entry block frequency.
+@end deftypefn
+
@deftypefn {Target Hook} bool TARGET_LRA_P (void)
A target hook which returns true if we use LRA instead of reload pass.
diff --git a/gcc/doc/tm.texi.in b/gcc/doc/tm.texi.in
index 631d04131e39..6dbe22581ca1 100644
--- a/gcc/doc/tm.texi.in
+++ b/gcc/doc/tm.texi.in
@@ -2388,6 +2388,8 @@ in the reload pass.
@hook TARGET_IRA_CHANGE_PSEUDO_ALLOCNO_CLASS
+@hook TARGET_IRA_CALLEE_SAVED_REGISTER_COST_SCALE
+
@hook TARGET_LRA_P
@hook TARGET_REGISTER_PRIORITY
diff --git a/gcc/ira-color.cc b/gcc/ira-color.cc
index 0699b349a1af..233060e15876 100644
--- a/gcc/ira-color.cc
+++ b/gcc/ira-color.cc
@@ -2180,8 +2180,7 @@ assign_hard_reg (ira_allocno_t a, bool retry_p)
+ ira_memory_move_cost[mode][rclass][1])
* saved_nregs / hard_regno_nregs (hard_reg
[gcc(refs/users/meissner/heads/work192-bugs)] Update ChangeLog.*
https://gcc.gnu.org/g:3a538ed3292ac1cdff806775ed8dcaca374ae9f7 commit 3a538ed3292ac1cdff806775ed8dcaca374ae9f7 Author: Michael Meissner Date: Thu Feb 6 18:06:16 2025 -0500 Update ChangeLog.* Diff: --- gcc/ChangeLog.bugs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/gcc/ChangeLog.bugs b/gcc/ChangeLog.bugs index 4bedd11965be..417b5a1e1462 100644 --- a/gcc/ChangeLog.bugs +++ b/gcc/ChangeLog.bugs @@ -1,4 +1,4 @@ - Branch work192-bugs, patch #214 + Branch work192-bugs, patch #215 Fix PR 118541, do not generate unordered fp cmoves for IEEE compares. @@ -116,6 +116,7 @@ gcc/testsuite/ PR target/118541 * gcc.target/powerpc/pr118541.c: New test. + Branch work192-bugs, patch #214 was reverted Branch work192-bugs, patch #213 was reverted Branch work192-bugs, patch #212 was reverted Branch work192-bugs, patch #211 was reverted
[gcc(refs/users/meissner/heads/work192-bugs)] Fix PR 118541, do not generate unordered fp cmoves for IEEE compares.
https://gcc.gnu.org/g:cb6ae536a6c5435667600c82af18c39af1b754de
commit cb6ae536a6c5435667600c82af18c39af1b754de
Author: Michael Meissner
Date: Thu Feb 6 18:04:12 2025 -0500
Fix PR 118541, do not generate unordered fp cmoves for IEEE compares.
This is version 2 of the patch.
In bug PR target/118541 on power9, power10, and power11 systems, for the
function:
extern double __ieee754_acos (double);
double
__acospi (double x)
{
double ret = __ieee754_acos (x) / 3.14;
return __builtin_isgreater (ret, 1.0) ? 1.0 : ret;
}
GCC currently generates the following code:
Power9 Power10 and Power11
== ===
bl __ieee754_acos bl __ieee754_acos@notoc
nop plfd 0,.LC0@pcrel
addis 9,2,.LC2@toc@ha xxspltidp 12,1065353216
addi 1,1,32 addi 1,1,32
lfd 0,.LC2@toc@l(9) ld 0,16(1)
addis 9,2,.LC0@toc@ha fdiv 0,1,0
ld 0,16(1) mtlr 0
lfd 12,.LC0@toc@l(9)xscmpgtdp 1,0,12
fdiv 0,1,0 xxsel 1,0,12,1
mtlr 0 blr
xscmpgtdp 1,0,12
xxsel 1,0,12,1
blr
This is because ifcvt.c optimizes the conditional floating point move to
use the
XSCMPGTDP instruction.
However, the XSCMPGTDP instruction will generate an interrupt if one of the
arguments is a signalling NaN and signalling NaNs can generate an interrupt.
The IEEE comparison functions (isgreater, etc.) require that the comparison
not
raise an interrupt.
The following patch changes the PowerPC back end so that ifcvt.c will not
change
the if/then test and move into a conditional move if the comparison is one
of
the comparisons that do not raise an error with signalling NaNs and -Ofast
is
not used. If a normal comparison is used or -Ofast is used, GCC will
continue
to generate XSCMPGTDP and XXSEL.
For the following code:
double
ordered_compare (double a, double b, double c, double d)
{
return __builtin_isgreater (a, b) ? c : d;
}
/* Verify normal > does generate xscmpgtdp. */
double
normal_compare (double a, double b, double c, double d)
{
return a > b ? c : d;
}
with the following patch, GCC generates the following for power9, power10,
and
power11:
ordered_compare:
fcmpu 0,1,2
fmr 1,4
bnglr 0
fmr 1,3
blr
normal_compare:
xscmpgtdp 1,1,2
xxsel 1,4,3,1
blr
Changes from the V1 patch:
1: I added a test in invert_fpmask_comparison_operator to not allow UNLE and
UNLT unless fast math is in force. Both invert_fpmask_comparison_operator
and
fpmask_comparison_operator are used to form floating point conditional
moves on
Power9 and beyond.
2: I reworked rs6000_reverse_condition to be a bit clearer when we are
rejecting
reversing IEEE comparisons that guarantee they don't trap.
I have built bootstrap compilers on big endian power9 systems and little
endian
power9/power10 systems and there were no regressions. Can I check this
patch
into the GCC trunk, and after a waiting period, can I check this into the
active
older branches?
2025-02-06 Michael Meissner
gcc/
PR target/118541
* config/rs6000/predicates.md (invert_fpmask_comparison_operator):
Do
not allow UNLT and UNLE unless -ffast-math.
* config/rs6000/rs6000-protos.h (REVERSE_COND_ORDERED_OK): New
macro.
(REVERSE_COND_NO_ORDERED): Likewise.
(rs6000_reverse_condition): Add argument.
* config/rs6000/rs6000.cc (rs6000_reverse_condition): Do not allow
ordered comparisons to be reversed for floating point cmoves.
(rs6000_emit_sCOND): Adjust rs6000_reverse_condition call.
* config/rs6000/rs6000.h (REVERSE_CONDITION): Likewise.
* config/rs6000/rs6000.md (reverse_branch_comparison): Name insn.
Adjust rs6000_reverse_condition call.
gcc/testsuite/
PR target/118541
* gcc.target/powerpc/pr118541.c: New test.
Diff:
---
gcc/config/rs6000/predicates.md | 4 ++-
gcc/config/rs6000/rs6000-protos.h | 6 +++-
gcc/config/rs6000/rs6000.cc | 23 +++
gcc/config/rs6000/rs6000.
[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] Factorisation gfc_conv_shift_descriptor
https://gcc.gnu.org/g:04da92462358478bbbc0d84c007cdfb0fe41d6d1
commit 04da92462358478bbbc0d84c007cdfb0fe41d6d1
Author: Mikael Morin
Date: Thu Feb 6 17:16:13 2025 +0100
Factorisation gfc_conv_shift_descriptor
Diff:
---
gcc/fortran/trans-array.cc | 79 --
1 file changed, 34 insertions(+), 45 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index c09b9bdab155..bcdc89ac8133 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -1476,7 +1476,7 @@ gfc_build_null_descriptor (tree type)
specified. This also updates ubound and offset accordingly. */
static void
-conv_shift_descriptor_lbound (stmtblock_t* block, tree desc, int dim,
+conv_shift_descriptor_lbound (stmtblock_t* block, tree from_desc, tree
to_desc, int dim,
tree new_lbound, tree offset)
{
tree ubound, lbound, stride;
@@ -1484,9 +1484,9 @@ conv_shift_descriptor_lbound (stmtblock_t* block, tree
desc, int dim,
new_lbound = fold_convert (gfc_array_index_type, new_lbound);
- lbound = gfc_conv_descriptor_lbound_get (desc, gfc_rank_cst[dim]);
- ubound = gfc_conv_descriptor_ubound_get (desc, gfc_rank_cst[dim]);
- stride = gfc_conv_descriptor_stride_get (desc, gfc_rank_cst[dim]);
+ lbound = gfc_conv_descriptor_lbound_get (from_desc, gfc_rank_cst[dim]);
+ ubound = gfc_conv_descriptor_ubound_get (from_desc, gfc_rank_cst[dim]);
+ stride = gfc_conv_descriptor_stride_get (from_desc, gfc_rank_cst[dim]);
/* Get difference (new - old) by which to shift stuff. */
diff = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
@@ -1496,7 +1496,7 @@ conv_shift_descriptor_lbound (stmtblock_t* block, tree
desc, int dim,
updating the lbound, as they depend on the lbound expression! */
ubound = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
ubound, diff);
- gfc_conv_descriptor_ubound_set (block, desc, gfc_rank_cst[dim], ubound);
+ gfc_conv_descriptor_ubound_set (block, to_desc, gfc_rank_cst[dim], ubound);
offs_diff = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
diff, stride);
tree tmp = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
@@ -1504,7 +1504,10 @@ conv_shift_descriptor_lbound (stmtblock_t* block, tree
desc, int dim,
gfc_add_modify (block, offset, tmp);
/* Finally set lbound to value we want. */
- gfc_conv_descriptor_lbound_set (block, desc, gfc_rank_cst[dim], new_lbound);
+ gfc_conv_descriptor_lbound_set (block, to_desc, gfc_rank_cst[dim],
new_lbound);
+
+ if (from_desc != to_desc)
+gfc_conv_descriptor_stride_set (block, to_desc, gfc_rank_cst[dim], stride);
}
@@ -1583,13 +1586,37 @@ conv_shift_descriptor (stmtblock_t *block, tree desc,
int rank,
for (int dim = 0; dim < rank; ++dim)
{
tree lower_bound = info.lower_bound (block, dim);
- conv_shift_descriptor_lbound (block, desc, dim, lower_bound, offset_var);
+ conv_shift_descriptor_lbound (block, desc, desc, dim, lower_bound,
offset_var);
}
gfc_conv_descriptor_offset_set (block, desc, offset_var);
}
+static void
+gfc_conv_shift_descriptor (stmtblock_t *block, tree dest, tree src,
+ int rank, const conditional_lb &lb)
+{
+ tree tmp = gfc_conv_descriptor_data_get (src);
+ gfc_conv_descriptor_data_set (block, dest, tmp);
+
+ tree offset_var = gfc_create_var (TREE_TYPE (tmp), "offset");
+ gfc_add_modify (block, offset_var, gfc_index_zero_node);
+
+ for (int n = 0 ; n < rank; n++)
+{
+ tree lbound;
+
+ lbound = lb.lower_bound (dest, n);
+ lbound = gfc_evaluate_now (lbound, block);
+
+ conv_shift_descriptor_lbound (block, src, dest, dim, lbound, offset_var);
+}
+
+ gfc_conv_descriptor_offset_set (block, dest, offset_var);
+}
+
+
void
gfc_conv_shift_descriptor (stmtblock_t* block, tree desc, int rank)
{
@@ -1876,44 +1903,6 @@ public:
};
-static void
-gfc_conv_shift_descriptor (stmtblock_t *block, tree dest, tree src,
- int rank, const conditional_lb &lb)
-{
- tree tmp = gfc_conv_descriptor_data_get (src);
- gfc_conv_descriptor_data_set (block, dest, tmp);
-
- tree offset = gfc_index_zero_node;
- for (int n = 0 ; n < rank; n++)
-{
- tree lbound;
-
- lbound = lb.lower_bound (dest, n);
- lbound = gfc_evaluate_now (lbound, block);
-
- tmp = gfc_conv_descriptor_ubound_get (src, gfc_rank_cst[n]);
- tmp = fold_build2_loc (input_location, PLUS_EXPR,
-gfc_array_index_type, tmp, lbound);
- gfc_conv_descriptor_lbound_set (block, dest,
- gfc_rank_cst[n], lbound);
- gfc_conv_descriptor_ubound_set (block, dest,
- gfc_rank_cst[n], tmp);
-
- /* Set stride and accumulate the offset. */
- tmp = gfc_conv_descriptor_strid
[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] Correction compil'
https://gcc.gnu.org/g:bec9cb8de934b8f191ef81e38f3757f8db787d8b
commit bec9cb8de934b8f191ef81e38f3757f8db787d8b
Author: Mikael Morin
Date: Thu Feb 6 17:22:49 2025 +0100
Correction compil'
Diff:
---
gcc/fortran/trans-array.cc | 36 ++--
1 file changed, 18 insertions(+), 18 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index bcdc89ac8133..afec6dcc45cb 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -1593,6 +1593,23 @@ conv_shift_descriptor (stmtblock_t *block, tree desc,
int rank,
}
+class conditional_lb
+{
+ tree cond;
+public:
+ conditional_lb (tree arg_cond)
+: cond (arg_cond) { }
+
+ tree lower_bound (tree src, int n) const {
+tree lbound = gfc_conv_descriptor_lbound_get (src, gfc_rank_cst[n]);
+lbound = fold_build3_loc (input_location, COND_EXPR,
+ gfc_array_index_type, cond,
+ gfc_index_one_node, lbound);
+return lbound;
+ }
+};
+
+
static void
gfc_conv_shift_descriptor (stmtblock_t *block, tree dest, tree src,
int rank, const conditional_lb &lb)
@@ -1610,7 +1627,7 @@ gfc_conv_shift_descriptor (stmtblock_t *block, tree dest,
tree src,
lbound = lb.lower_bound (dest, n);
lbound = gfc_evaluate_now (lbound, block);
- conv_shift_descriptor_lbound (block, src, dest, dim, lbound, offset_var);
+ conv_shift_descriptor_lbound (block, src, dest, n, lbound, offset_var);
}
gfc_conv_descriptor_offset_set (block, dest, offset_var);
@@ -1886,23 +1903,6 @@ gfc_conv_remap_descriptor (stmtblock_t *block, tree
dest, tree src,
}
-class conditional_lb
-{
- tree cond;
-public:
- conditional_lb (tree arg_cond)
-: cond (arg_cond) { }
-
- tree lower_bound (tree src, int n) const {
-tree lbound = gfc_conv_descriptor_lbound_get (src, gfc_rank_cst[n]);
-lbound = fold_build3_loc (input_location, COND_EXPR,
- gfc_array_index_type, cond,
- gfc_index_one_node, lbound);
-return lbound;
- }
-};
-
-
void
gfc_conv_shift_descriptor (stmtblock_t *block, tree dest, tree src,
int rank, tree zero_cond)
[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] Factorisation gfc_conv_shift_descriptor.
https://gcc.gnu.org/g:035bdb799f70352f41fe436fd9d03c642e115e0f
commit 035bdb799f70352f41fe436fd9d03c642e115e0f
Author: Mikael Morin
Date: Thu Feb 6 18:02:37 2025 +0100
Factorisation gfc_conv_shift_descriptor.
Diff:
---
gcc/fortran/trans-array.cc | 103 -
1 file changed, 55 insertions(+), 48 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 2cca5e211469..d5c7b1344697 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -1477,28 +1477,32 @@ gfc_build_null_descriptor (tree type)
static void
conv_shift_descriptor_lbound (stmtblock_t* block, tree from_desc, tree
to_desc, int dim,
- tree new_lbound, tree offset)
+ tree new_lbound, tree offset, bool
relative_offset)
{
- tree ubound, lbound, stride;
- tree diff, offs_diff;
-
new_lbound = fold_convert (gfc_array_index_type, new_lbound);
- lbound = gfc_conv_descriptor_lbound_get (from_desc, gfc_rank_cst[dim]);
- ubound = gfc_conv_descriptor_ubound_get (from_desc, gfc_rank_cst[dim]);
- stride = gfc_conv_descriptor_stride_get (from_desc, gfc_rank_cst[dim]);
+ tree lbound = gfc_conv_descriptor_lbound_get (from_desc, gfc_rank_cst[dim]);
+ tree ubound = gfc_conv_descriptor_ubound_get (from_desc, gfc_rank_cst[dim]);
+ tree stride = gfc_conv_descriptor_stride_get (from_desc, gfc_rank_cst[dim]);
/* Get difference (new - old) by which to shift stuff. */
- diff = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
- new_lbound, lbound);
+ tree diff = fold_build2_loc (input_location, MINUS_EXPR,
gfc_array_index_type,
+ new_lbound, lbound);
/* Shift ubound and offset accordingly. This has to be done before
updating the lbound, as they depend on the lbound expression! */
ubound = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
ubound, diff);
gfc_conv_descriptor_ubound_set (block, to_desc, gfc_rank_cst[dim], ubound);
+
+ tree offs_diff;
+ if (relative_offset)
+offs_diff = diff;
+ else
+offs_diff = lbound;
+
offs_diff = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
- diff, stride);
+ offs_diff, stride);
tree tmp = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
offset, offs_diff);
gfc_add_modify (block, offset, tmp);
@@ -1515,6 +1519,7 @@ class lb_info_base
{
public:
virtual tree lower_bound (stmtblock_t *block, int dim) const = 0;
+ virtual bool relative_offset () const { return true; }
};
@@ -1575,62 +1580,64 @@ public:
static void
-conv_shift_descriptor (stmtblock_t *block, tree desc, int rank,
+conv_shift_descriptor (stmtblock_t *block, tree src, tree dest, int rank,
const lb_info_base &info)
{
- tree tmp = gfc_conv_descriptor_offset_get (desc);
- tree offset_var = gfc_create_var (TREE_TYPE (tmp), "offset");
- gfc_add_modify (block, offset_var, tmp);
+ if (src != dest)
+{
+ tree tmp = gfc_conv_descriptor_data_get (src);
+ gfc_conv_descriptor_data_set (block, dest, tmp);
+}
+
+ tree offset_var = gfc_create_var (gfc_array_index_type, "offset");
+ tree init_offset;
+ if (info.relative_offset ())
+init_offset = gfc_conv_descriptor_offset_get (src);
+ else
+init_offset = gfc_index_zero_node;
+ gfc_add_modify (block, offset_var, init_offset);
/* Apply a shift of the lbound when supplied. */
for (int dim = 0; dim < rank; ++dim)
{
tree lower_bound = info.lower_bound (block, dim);
- conv_shift_descriptor_lbound (block, desc, desc, dim, lower_bound,
offset_var);
+ conv_shift_descriptor_lbound (block, src, dest, dim, lower_bound,
offset_var,
+ info.relative_offset ());
}
- gfc_conv_descriptor_offset_set (block, desc, offset_var);
+ gfc_conv_descriptor_offset_set (block, dest, offset_var);
+}
+
+
+static void
+conv_shift_descriptor (stmtblock_t *block, tree desc, int rank,
+ const lb_info_base &info)
+{
+ conv_shift_descriptor (block, desc, desc, rank, info);
}
-class conditional_lb
+class cond_descr_lb : public lb_info_base
{
+ tree desc;
tree cond;
public:
- conditional_lb (tree arg_cond)
-: cond (arg_cond) { }
+ cond_descr_lb (tree arg_desc, tree arg_cond)
+: desc (arg_desc), cond (arg_cond) { }
- tree lower_bound (tree src, int n) const {
-tree lbound = gfc_conv_descriptor_lbound_get (src, gfc_rank_cst[n]);
-lbound = fold_build3_loc (input_location, COND_EXPR,
- gfc_array_index_type, cond,
- gfc_index_one_node, lbound);
-return lbound;
- }
+ virtual tree lower_bound (stmtblock_t *block, int dim) const;
+ virtual bool relative_offset () const { retur
[gcc r15-7389] Fortran: FIx ICE in associate with elemental function [PR118750]
https://gcc.gnu.org/g:a03303b4d5b2ca58e5750a4d5bd735d85a091273
commit r15-7389-ga03303b4d5b2ca58e5750a4d5bd735d85a091273
Author: Paul Thomas
Date: Thu Feb 6 16:40:19 2025 +
Fortran: FIx ICE in associate with elemental function [PR118750]
2025-02-06 Paul Thomas
gcc/fortran
PR fortran/118750
* resolve.cc (resolve_assoc_var): If the target expression has
a rank, do not use gfc_expression_rank, since it will return 0
if the function is elemental. Resolution will have produced the
correct rank.
gcc/testsuite/
PR fortran/118750
* gfortran.dg/associate_72.f90: New test.
Diff:
---
gcc/fortran/resolve.cc | 2 +-
gcc/testsuite/gfortran.dg/associate_72.f90 | 26 ++
2 files changed, 27 insertions(+), 1 deletion(-)
diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index c9736db908fe..7adbf958aec1 100644
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -10728,7 +10728,7 @@ resolve_assoc_var (gfc_symbol* sym, bool resolve_target)
|| gfc_is_ptr_fcn (target));
/* Finally resolve if this is an array or not. */
- if (target->expr_type == EXPR_FUNCTION
+ if (target->expr_type == EXPR_FUNCTION && target->rank == 0
&& (sym->ts.type == BT_CLASS || sym->ts.type == BT_DERIVED))
{
gfc_expression_rank (target);
diff --git a/gcc/testsuite/gfortran.dg/associate_72.f90
b/gcc/testsuite/gfortran.dg/associate_72.f90
new file mode 100644
index ..993ebdfd5a7e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/associate_72.f90
@@ -0,0 +1,26 @@
+! { dg-do compile }
+! { dg-options "-fdump-tree-original" }
+!
+! Test the fix for the 14/15 regression PR118750
+!
+! Contributed by Damian Rouson
+!
+ implicit none
+
+ type string_t
+character(:), allocatable :: str
+ end type
+
+ associate(str_a => get_string([string_t ("abcd"),string_t ("ef")]))
+if (str_a(1)%str//str_a(2)%str /= "abcdef") STOP 1 ! Returned "Invalid
array reference at (1)"
+ end associate
+
+contains
+
+ type(string_t) elemental function get_string(mold)
+class(string_t), intent(in) :: mold
+get_string = string_t(mold%str)
+ end function
+
+end
+! { dg-final { scan-tree-dump-times "array01_string_t str_a" 1 "original" } }
