[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] Déplacement fonction
https://gcc.gnu.org/g:e8d300a99c04a71f4d418cb2461363f29c30b602
commit e8d300a99c04a71f4d418cb2461363f29c30b602
Author: Mikael Morin
Date: Fri Feb 14 09:34:02 2025 +0100
Déplacement fonction
Diff:
---
gcc/fortran/trans-array.cc | 53 ++
gcc/fortran/trans-array.h | 1 +
gcc/fortran/trans-expr.cc | 41 ++-
3 files changed, 47 insertions(+), 48 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 3bfe41c64013..8981a420c97a 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -2225,6 +2225,44 @@ gfc_conv_shift_descriptor_subarray (stmtblock_t *block,
tree desc,
}
+void
+gfc_conv_shift_descriptor (stmtblock_t *block, tree desc, int rank,
+ tree lbound[GFC_MAX_DIMENSIONS],
+ tree ubound[GFC_MAX_DIMENSIONS])
+{
+ tree size = gfc_index_one_node;
+ tree offset = gfc_index_zero_node;
+ for (int n = 0; n < rank; n++)
+{
+ tree tmp = gfc_conv_descriptor_ubound_get (desc, gfc_rank_cst[n]);
+ tmp = fold_build2_loc (input_location, PLUS_EXPR,
+gfc_array_index_type, tmp,
+gfc_index_one_node);
+ gfc_conv_descriptor_ubound_set (block,
+ desc,
+ gfc_rank_cst[n],
+ tmp);
+ gfc_conv_descriptor_lbound_set (block,
+ desc,
+ gfc_rank_cst[n],
+ gfc_index_one_node);
+ size = gfc_evaluate_now (size, block);
+ offset = fold_build2_loc (input_location, MINUS_EXPR,
+ gfc_array_index_type,
+ offset, size);
+ offset = gfc_evaluate_now (offset, block);
+ tmp = gfc_conv_array_extent_dim (lbound[n], ubound[n], nullptr);
+ size = fold_build2_loc (input_location, MULT_EXPR,
+ gfc_array_index_type, size, tmp);
+}
+
+ gfc_conv_descriptor_offset_set (block, desc,
+ offset);
+}
+
+
+
+
int
gfc_descriptor_rank (tree descriptor)
{
@@ -8392,15 +8430,12 @@ gfc_array_init_size (tree descriptor, int rank, int
corank, tree * poffset,
start at zero, but when allocating it, the standard expects
the array to start at one. Therefore fix the upper bound to be
(desc.ubound - desc.lbound) + 1. */
- tmp = fold_build2_loc (input_location, MINUS_EXPR,
-gfc_array_index_type,
-gfc_conv_descriptor_ubound_get (
- expr3_desc, gfc_rank_cst[n]),
-gfc_conv_descriptor_lbound_get (
- expr3_desc, gfc_rank_cst[n]));
- tmp = fold_build2_loc (input_location, PLUS_EXPR,
-gfc_array_index_type, tmp,
-gfc_index_one_node);
+ tmp = gfc_conv_array_extent_dim (
+ gfc_conv_descriptor_lbound_get (expr3_desc,
+ gfc_rank_cst[n]),
+ gfc_conv_descriptor_ubound_get (expr3_desc,
+ gfc_rank_cst[n]),
+ nullptr);
se.expr = gfc_evaluate_now (tmp, pblock);
}
else
diff --git a/gcc/fortran/trans-array.h b/gcc/fortran/trans-array.h
index 836a177da014..f37f09c21cff 100644
--- a/gcc/fortran/trans-array.h
+++ b/gcc/fortran/trans-array.h
@@ -237,6 +237,7 @@ 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);
void gfc_conv_shift_descriptor_subarray (stmtblock_t*, tree, gfc_expr *,
gfc_expr *);
+void gfc_conv_shift_descriptor (stmtblock_t *, tree, int, tree *, 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 016ac2ee944c..13cb7f9fd8fa 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -5207,43 +5207,6 @@ gfc_apply_interface_mapping (gfc_interface_mapping *
mapping,
}
-static void
-shift_descriptor (stmtblock_t *block, tree desc, int rank,
- tree lbound[GFC_MAX_DIMENSIONS],
- tree ubound[GFC_MAX_DIMENSIONS])
-
-{
- tree size = gfc_index_one_node;
- tree offset = gfc_index_zero_node;
- for (int n = 0; n < rank; n++)
-{
- tree tmp = gfc_conv_descriptor_ubound_get (desc, gfc_rank_cst[n]);
- tmp = fold_build2_loc (input_location, PLUS_EXPR,
-gf
[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] Factorisation shift_descriptor
https://gcc.gnu.org/g:cbb7977daa02944d45d569246e354b5c24fab722
commit cbb7977daa02944d45d569246e354b5c24fab722
Author: Mikael Morin
Date: Thu Feb 13 21:03:54 2025 +0100
Factorisation shift_descriptor
Diff:
---
gcc/fortran/trans-expr.cc | 76 ---
1 file changed, 39 insertions(+), 37 deletions(-)
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 6ed87fc63a9b..016ac2ee944c 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -5207,6 +5207,43 @@ gfc_apply_interface_mapping (gfc_interface_mapping *
mapping,
}
+static void
+shift_descriptor (stmtblock_t *block, tree desc, int rank,
+ tree lbound[GFC_MAX_DIMENSIONS],
+ tree ubound[GFC_MAX_DIMENSIONS])
+
+{
+ tree size = gfc_index_one_node;
+ tree offset = gfc_index_zero_node;
+ for (int n = 0; n < rank; n++)
+{
+ tree tmp = gfc_conv_descriptor_ubound_get (desc, gfc_rank_cst[n]);
+ tmp = fold_build2_loc (input_location, PLUS_EXPR,
+gfc_array_index_type, tmp,
+gfc_index_one_node);
+ gfc_conv_descriptor_ubound_set (block,
+ desc,
+ gfc_rank_cst[n],
+ tmp);
+ gfc_conv_descriptor_lbound_set (block,
+ desc,
+ gfc_rank_cst[n],
+ gfc_index_one_node);
+ size = gfc_evaluate_now (size, block);
+ offset = fold_build2_loc (input_location, MINUS_EXPR,
+ gfc_array_index_type,
+ offset, size);
+ offset = gfc_evaluate_now (offset, block);
+ tmp = gfc_conv_array_extent_dim (lbound[n], ubound[n], nullptr);
+ size = fold_build2_loc (input_location, MULT_EXPR,
+ gfc_array_index_type, size, tmp);
+}
+
+ gfc_conv_descriptor_offset_set (block, desc,
+ offset);
+}
+
+
/* Returns a reference to a temporary array into which a component of
an actual argument derived type array is copied and then returned
after the function call. */
@@ -5227,7 +5264,6 @@ gfc_conv_subref_array_arg (gfc_se *se, gfc_expr * expr,
int g77,
tree tmp_index;
tree tmp;
tree base_type;
- tree size;
stmtblock_t body;
int n;
int dimen;
@@ -5471,42 +5507,8 @@ class_array_fcn:
/* Determine the offset for pointer formal arguments and set the
lbounds to one. */
if (formal_ptr)
-{
- size = gfc_index_one_node;
- offset = gfc_index_zero_node;
- for (n = 0; n < dimen; n++)
- {
- tmp = gfc_conv_descriptor_ubound_get (parmse->expr,
- gfc_rank_cst[n]);
- tmp = fold_build2_loc (input_location, PLUS_EXPR,
-gfc_array_index_type, tmp,
-gfc_index_one_node);
- gfc_conv_descriptor_ubound_set (&parmse->pre,
- parmse->expr,
- gfc_rank_cst[n],
- tmp);
- gfc_conv_descriptor_lbound_set (&parmse->pre,
- parmse->expr,
- gfc_rank_cst[n],
- gfc_index_one_node);
- size = gfc_evaluate_now (size, &parmse->pre);
- offset = fold_build2_loc (input_location, MINUS_EXPR,
- gfc_array_index_type,
- offset, size);
- offset = gfc_evaluate_now (offset, &parmse->pre);
- tmp = fold_build2_loc (input_location, MINUS_EXPR,
-gfc_array_index_type,
-rse.loop->to[n], rse.loop->from[n]);
- tmp = fold_build2_loc (input_location, PLUS_EXPR,
-gfc_array_index_type,
-tmp, gfc_index_one_node);
- size = fold_build2_loc (input_location, MULT_EXPR,
- gfc_array_index_type, size, tmp);
- }
-
- gfc_conv_descriptor_offset_set (&parmse->pre, parmse->expr,
- offset);
-}
+shift_descriptor (&parmse->pre, parmse->expr, dimen,
+ rse.loop->from, rse.loop->to);
/* We want either the address for the data or the address of the descriptor,
depending on the mode of passing array arguments. */
[gcc r15-7529] libstdc++: Fix use of make_pair that used ADL
https://gcc.gnu.org/g:d5fb86cbec48af24d3ec56519fdf8b0c4133b801
commit r15-7529-gd5fb86cbec48af24d3ec56519fdf8b0c4133b801
Author: Jonathan Wakely
Date: Wed Feb 12 18:30:21 2025 +
libstdc++: Fix use of make_pair that used ADL
_Rb_tree::_M_equal_range calls make_pair unqualified, which means it
uses ADL. As the new testcase shows, this can find something other than
std::make_pair. Rather than just changing it to use a qualified call,
remove the use of make_pair entirely. We don't need to deduce any types
here, we know exactly what type of std::pair we want to construct, so do
that explicitly.
libstdc++-v3/ChangeLog:
* include/bits/stl_tree.h (_Rb_tree::_M_equal_range): Replace
unqualified call to make_pair with explicit construction of
std::pair.
* testsuite/23_containers/set/operations/equal_range_adl.cc:
New test.
Diff:
---
libstdc++-v3/include/bits/stl_tree.h | 18 ---
.../set/operations/equal_range_adl.cc | 26 ++
2 files changed, 36 insertions(+), 8 deletions(-)
diff --git a/libstdc++-v3/include/bits/stl_tree.h
b/libstdc++-v3/include/bits/stl_tree.h
index 7285676f427f..6b35f99a25a3 100644
--- a/libstdc++-v3/include/bits/stl_tree.h
+++ b/libstdc++-v3/include/bits/stl_tree.h
@@ -2633,6 +2633,8 @@ namespace __rb_tree
_Rb_tree<_Key, _Val, _KeyOfValue, _Compare, _Alloc>::
equal_range(const _Key& __k)
{
+ typedef pair _Ret;
+
_Base_ptr __x = _M_begin();
_Base_ptr __y = _M_end();
while (__x)
@@ -2647,12 +2649,11 @@ namespace __rb_tree
_Base_ptr __yu(__y);
__y = __x, __x = _S_left(__x);
__xu = _S_right(__xu);
- return make_pair(iterator(_M_lower_bound(__x, __y, __k)),
- iterator(_M_upper_bound(__xu, __yu, __k)));
+ return _Ret(iterator(_M_lower_bound(__x, __y, __k)),
+ iterator(_M_upper_bound(__xu, __yu, __k)));
}
}
- return pair(iterator(__y),
- iterator(__y));
+ return _Ret(iterator(__y), iterator(__y));
}
template::
equal_range(const _Key& __k) const
{
+ typedef pair _Ret;
+
_Base_ptr __x = _M_begin();
_Base_ptr __y = _M_end();
while (__x)
@@ -2678,12 +2681,11 @@ namespace __rb_tree
_Base_ptr __yu(__y);
__y = __x, __x = _S_left(__x);
__xu = _S_right(__xu);
- return make_pair(const_iterator(_M_lower_bound(__x, __y, __k)),
- const_iterator(_M_upper_bound(__xu, __yu, __k)));
+ return _Ret(const_iterator(_M_lower_bound(__x, __y, __k)),
+ const_iterator(_M_upper_bound(__xu, __yu, __k)));
}
}
- return pair(const_iterator(__y),
- const_iterator(__y));
+ return _Ret(const_iterator(__y), const_iterator(__y));
}
template
+
+namespace adl
+{
+#if __cplusplus < 201103L
+ template void make_pair(const T&, const T&) { }
+#else
+ template void make_pair(T&&, T&&) { }
+#endif
+
+ struct X { bool operator<(const X&) const { return false; } };
+}
+
+typedef std::set Set;
+
+void
+test_equal_range(Set& s, const adl::X& x)
+{
+ // _Rb_tree::_M_equal_range was using make_pair unqualified.
+ (void) s.equal_range(x);
+ const Set& cs = s;
+ // Similarly for the const overload.
+ (void) cs.equal_range(x);
+}
[gcc r15-7530] libstdc++: Fix more unqualified uses of make_pair
https://gcc.gnu.org/g:06724b6079b5ad983f7d29b39b4cc38cde0f37b3 commit r15-7530-g06724b6079b5ad983f7d29b39b4cc38cde0f37b3 Author: Jonathan Wakely Date: Wed Feb 12 18:33:46 2025 + libstdc++: Fix more unqualified uses of make_pair There are some unqualified calls to make_pair in Parallel Mode. Fix these by just using a qualified call, because it's simpler and I don't care about this code much. libstdc++-v3/ChangeLog: * include/parallel/algobase.h (__mismatch_switch): Qualify calls to make_pair to avoid ADL. Diff: --- libstdc++-v3/include/parallel/algobase.h | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/libstdc++-v3/include/parallel/algobase.h b/libstdc++-v3/include/parallel/algobase.h index a47230c8b937..0f3b979a8f20 100644 --- a/libstdc++-v3/include/parallel/algobase.h +++ b/libstdc++-v3/include/parallel/algobase.h @@ -84,7 +84,7 @@ namespace __parallel __gnu_parallel::__find_template(__begin1, __end1, __begin2, __pred, __gnu_parallel:: __mismatch_selector()).first; - return make_pair(__res , __begin2 + (__res - __begin1)); + return std::make_pair(__res , __begin2 + (__res - __begin1)); } else return _GLIBCXX_STD_A::mismatch(__begin1, __end1, __begin2, __pred); @@ -165,7 +165,7 @@ namespace __parallel __gnu_parallel::__find_template(__begin1, __end1, __begin2, __pred, __gnu_parallel:: __mismatch_selector()).first; - return make_pair(__res , __begin2 + (__res - __begin1)); + return std::make_pair(__res , __begin2 + (__res - __begin1)); } else return _GLIBCXX_STD_A::mismatch(__begin1, __end1,
[gcc r15-7537] c++: add fixed test [PR82794]
https://gcc.gnu.org/g:77ba1ab85d3a45005bfff90b2fd262e102e5383a
commit r15-7537-g77ba1ab85d3a45005bfff90b2fd262e102e5383a
Author: Marek Polacek
Date: Fri Feb 14 16:04:41 2025 -0500
c++: add fixed test [PR82794]
Fixed by r10-3735.
PR c++/82794
gcc/testsuite/ChangeLog:
* g++.dg/cpp2a/concepts-pr82794.C: New test.
Diff:
---
gcc/testsuite/g++.dg/cpp2a/concepts-pr82794.C | 8
1 file changed, 8 insertions(+)
diff --git a/gcc/testsuite/g++.dg/cpp2a/concepts-pr82794.C
b/gcc/testsuite/g++.dg/cpp2a/concepts-pr82794.C
new file mode 100644
index ..b84e9ec45f6d
--- /dev/null
+++ b/gcc/testsuite/g++.dg/cpp2a/concepts-pr82794.C
@@ -0,0 +1,8 @@
+// PR c++/82794
+// { dg-do compile { target c++20 } }
+
+template
+concept Foo = true;
+
+template
+using foo = void;
[gcc r15-7536] c++: add fixed test [PR70037]
https://gcc.gnu.org/g:9fd4e414830bb84b1cf1a7df4945d26c078729c9
commit r15-7536-g9fd4e414830bb84b1cf1a7df4945d26c078729c9
Author: Marek Polacek
Date: Fri Feb 14 15:50:09 2025 -0500
c++: add fixed test [PR70037]
Fixed by r11-735 + r11-2417.
PR c++/70037
gcc/testsuite/ChangeLog:
* g++.dg/cpp2a/concepts-pr70037.C: New test.
Diff:
---
gcc/testsuite/g++.dg/cpp2a/concepts-pr70037.C | 18 ++
1 file changed, 18 insertions(+)
diff --git a/gcc/testsuite/g++.dg/cpp2a/concepts-pr70037.C
b/gcc/testsuite/g++.dg/cpp2a/concepts-pr70037.C
new file mode 100644
index ..7382764ea01b
--- /dev/null
+++ b/gcc/testsuite/g++.dg/cpp2a/concepts-pr70037.C
@@ -0,0 +1,18 @@
+// PR c++/70037
+// { dg-do compile { target c++20 } }
+
+namespace std {
+ template
+ struct F {
+static constexpr bool value = false;
+ };
+
+ template
+ struct tuple {
+constexpr tuple() requires (F::value) {}
+explicit constexpr tuple() requires (F::value) && (true) {}
+ };
+}
+
+using std::tuple;
+template struct std::tuple>;
[gcc r15-7538] c++: add fixed test [PR82936]
https://gcc.gnu.org/g:dfd1b1abab9d3159e6f43e234ab78638f92d613e
commit r15-7538-gdfd1b1abab9d3159e6f43e234ab78638f92d613e
Author: Marek Polacek
Date: Fri Feb 14 16:18:25 2025 -0500
c++: add fixed test [PR82936]
Fixed by r8-6829-gaaec81f10fa314; before that:
Segmentation fault (core dumped)
PR c++/82936
gcc/testsuite/ChangeLog:
* g++.dg/cpp0x/vt-82936.C: New test.
Diff:
---
gcc/testsuite/g++.dg/cpp0x/vt-82936.C | 18 ++
1 file changed, 18 insertions(+)
diff --git a/gcc/testsuite/g++.dg/cpp0x/vt-82936.C
b/gcc/testsuite/g++.dg/cpp0x/vt-82936.C
new file mode 100644
index ..3c489686204b
--- /dev/null
+++ b/gcc/testsuite/g++.dg/cpp0x/vt-82936.C
@@ -0,0 +1,18 @@
+// PR c++/82936
+// { dg-do compile { target c++11 } }
+
+int fun(int i)
+{
+return 0;
+}
+template
+struct outer;
+template
+struct outer
+{
+template
+struct callable
+{
+};
+};
+outer::callable f;
[gcc r15-7547] libstdc++: Improve list assumption after constructor [PR118865]
https://gcc.gnu.org/g:0c3cc57f0e71a7a945fb10c817260dd8a7894e7f
commit r15-7547-g0c3cc57f0e71a7a945fb10c817260dd8a7894e7f
Author: Andrew Pinski
Date: Thu Feb 13 14:10:06 2025 -0800
libstdc++: Improve list assumption after constructor [PR118865]
The code example here does:
```
if (begin == end) __builtin_unreachable();
std::list nl(begin, end);
for (auto it = nl.begin(); it != nl.end(); it++)
{
...
}
/* Remove the first element of the list. */
nl.erase(nl.begin());
```
And we get a warning because because we jump threaded the case were we
think the list was empty from the for loop BUT we populated it without
an empty array. So can help the compiler here by adding that after
initializing
the list with non empty array, that the list will not be empty either.
This is able to remove the -Wfree-nonheap-object warning in the first
reduced
testcase (with the fix for `begin == end` case added) in the PR 118865; the
second
reduced testcase has been filed off as PR 118867.
Bootstrapped and tested on x86_64-linux-gnu.
libstdc++-v3/ChangeLog:
PR libstdc++/118865
* include/bits/stl_list.h (_M_initialize_dispatch): Add an
unreachable if the iterator was not empty that the list will
now be not empty.
Signed-off-by: Andrew Pinski
Diff:
---
libstdc++-v3/include/bits/stl_list.h | 6 ++
1 file changed, 6 insertions(+)
diff --git a/libstdc++-v3/include/bits/stl_list.h
b/libstdc++-v3/include/bits/stl_list.h
index be33eeb03d44..f987d8b9d0a3 100644
--- a/libstdc++-v3/include/bits/stl_list.h
+++ b/libstdc++-v3/include/bits/stl_list.h
@@ -2384,12 +2384,18 @@ _GLIBCXX_BEGIN_NAMESPACE_CXX11
_M_initialize_dispatch(_InputIterator __first, _InputIterator __last,
__false_type)
{
+ bool __notempty = __first != __last;
for (; __first != __last; ++__first)
#if __cplusplus >= 201103L
emplace_back(*__first);
#else
push_back(*__first);
#endif
+if (__notempty)
+ {
+if (begin() == end())
+ __builtin_unreachable();
+ }
}
// Called by list(n,v,a), and the range constructor when it turns out
[gcc r15-7539] c++: add fixed test [PR86933]
https://gcc.gnu.org/g:80b9c9c844458779556995a5be7c08a8894d0f96
commit r15-7539-g80b9c9c844458779556995a5be7c08a8894d0f96
Author: Patrick Palka
Date: Fri Feb 14 16:28:42 2025 -0500
c++: add fixed test [PR86933]
Fixed by the PR118265 fix r15-7339-g26d3424ca5d9f4.
PR c++/86933
gcc/testsuite/ChangeLog:
* g++.dg/cpp1z/variadic-nontype1.C: Mention PR number.
* g++.dg/cpp1z/variadic-nontype2.C: New test.
Diff:
---
gcc/testsuite/g++.dg/cpp1z/variadic-nontype1.C | 2 ++
gcc/testsuite/g++.dg/cpp1z/variadic-nontype2.C | 12
2 files changed, 14 insertions(+)
diff --git a/gcc/testsuite/g++.dg/cpp1z/variadic-nontype1.C
b/gcc/testsuite/g++.dg/cpp1z/variadic-nontype1.C
index ad2af623b139..594857a99841 100644
--- a/gcc/testsuite/g++.dg/cpp1z/variadic-nontype1.C
+++ b/gcc/testsuite/g++.dg/cpp1z/variadic-nontype1.C
@@ -1,4 +1,6 @@
+// PR c++/118265
// { dg-do compile { target c++17 } }
+
struct Class1
{
void apply_bool(bool){}
diff --git a/gcc/testsuite/g++.dg/cpp1z/variadic-nontype2.C
b/gcc/testsuite/g++.dg/cpp1z/variadic-nontype2.C
new file mode 100644
index ..4c112eaf3ac9
--- /dev/null
+++ b/gcc/testsuite/g++.dg/cpp1z/variadic-nontype2.C
@@ -0,0 +1,12 @@
+// PR c++/86933
+// { dg-do compile { target c++17 } }
+
+template struct TT;
+template struct TT {};
+
+struct X {
+int x;
+double y;
+};
+
+TT<&X::x, &X::y> t;
[gcc r15-7544] AVR: target/118878 - Don't ICE on result from paradoxical reg's alloc.
https://gcc.gnu.org/g:1dc4e220ca2272d668ddb3041ccd9e69b968e532
commit r15-7544-g1dc4e220ca2272d668ddb3041ccd9e69b968e532
Author: Georg-Johann Lay
Date: Fri Feb 14 18:53:29 2025 +0100
AVR: target/118878 - Don't ICE on result from paradoxical reg's alloc.
After register allocation, paradoxical subregs may become something
like r20:SI += r22:SI which doesn't make much sense as assembly code.
Hence avr_out_plus_1() used to ICE on such code. However, paradoxical
subregs appear to be a common optimization device (instead of proper
mode demotion).
PR target/118878
gcc/
* config/avr/avr.cc (avr_out_plus_1): Don't ICE on result of
paradoxical reg's register allocation.
gcc/testsuite/
* gcc.target/avr/torture/pr118878.c: New test.
Diff:
---
gcc/config/avr/avr.cc | 20 ---
gcc/testsuite/gcc.target/avr/torture/pr118878.c | 78 +
2 files changed, 91 insertions(+), 7 deletions(-)
diff --git a/gcc/config/avr/avr.cc b/gcc/config/avr/avr.cc
index bb00e3347206..e358a2e8b8da 100644
--- a/gcc/config/avr/avr.cc
+++ b/gcc/config/avr/avr.cc
@@ -8782,6 +8782,16 @@ avr_out_plus_1 (rtx insn, rtx *xop, int *plen, rtx_code
code,
if (REG_P (xop[2]))
{
+ if (REGNO (xop[0]) != REGNO (xop[2])
+ && reg_overlap_mentioned_p (xop[0], xop[2]))
+ {
+ /* PR118878: Paradoxical SUBREGs may result in overlapping
+registers. The assumption is that the overlapping part
+is unused garbage. */
+ gcc_assert (n_bytes <= 4);
+ n_bytes = std::abs ((int) REGNO (xop[0]) - (int) REGNO (xop[2]));
+ }
+
for (int i = 0; i < n_bytes; i++)
{
/* We operate byte-wise on the destination. */
@@ -8796,13 +8806,9 @@ avr_out_plus_1 (rtx insn, rtx *xop, int *plen, rtx_code
code,
op, plen, 1);
}
- if (reg_overlap_mentioned_p (xop[0], xop[2]))
- {
- gcc_assert (REGNO (xop[0]) == REGNO (xop[2]));
-
- if (MINUS == code)
- return;
- }
+ if (MINUS == code
+ && REGNO (xop[0]) == REGNO (xop[2]))
+ return;
goto saturate;
}
diff --git a/gcc/testsuite/gcc.target/avr/torture/pr118878.c
b/gcc/testsuite/gcc.target/avr/torture/pr118878.c
new file mode 100644
index ..d2d8a22fbda7
--- /dev/null
+++ b/gcc/testsuite/gcc.target/avr/torture/pr118878.c
@@ -0,0 +1,78 @@
+/* { dg-do run { target { ! avr_tiny } } } */
+/* { dg-additional-options { -std=c99 } } */
+
+#ifdef __AVR_HAVE_LPMX__
+
+/* From include */
+
+typedef __UINT8_TYPE__ uint8_t;
+typedef __UINT16_TYPE__ uint16_t;
+typedef __UINT32_TYPE__ uint32_t;
+typedef uint32_t uint_farptr_t;
+
+#define pgm_read_dword_far(__addr) __ELPM_dword (__addr)
+
+#define __ELPM_dword(addr)\
+ (__extension__({\
+ uint_farptr_t __addr32 = (addr);\
+ uint32_t __result; \
+ __ELPM__4 (__result, __addr32, uint32_t); \
+ __result; }))
+
+/* Has no ELPM: Fallback to LPM. */
+#define __ELPM__4(r,a,T) const T *__a = (const T*)(uint16_t) a; __LPM__4(r,__a)
+
+#define __LPM__4(res,addr) \
+ __asm volatile ("lpm %A0,%a1+" "\n\t" \
+ "lpm %B0,%a1+" "\n\t" \
+ "lpm %C0,%a1+" "\n\t" \
+ "lpm %D0,%a1+" : "=r" (res), "+z" (addr))
+
+#define PROGMEM __attribute__((__progmem__))
+
+#define pgm_get_far_address(var) \
+ (__extension__({ uint_farptr_t __tmp; \
+ __asm__ ("ldi%A0, lo8(%1)" "\n\t" \
+ "ldi%B0, hi8(%1)" "\n\t" \
+ "ldi%C0, hh8(%1)" "\n\t" \
+ "clr%D0" : "=d" (__tmp) : "i" (&(var)) ); __tmp; }))
+
+/*/
+
+#define VAL 0x01050711
+
+PROGMEM
+const uint32_t data[] = { VAL, 2 * VAL, 7 * VAL };
+
+uint32_t get_val (uint8_t i)
+{
+ uint32_t v = VAL;
+ if (i == 1) v *= 2;
+ if (i == 2) v *= 7;
+ return v;
+}
+
+__attribute__((noinline,noclone))
+void test (uint8_t i)
+{
+ if (pgm_read_dword_far (pgm_get_far_address (data[0])) != get_val (0))
+__builtin_exit (__LINE__);
+
+ uint_farptr_t pf = pgm_get_far_address (data[0]) + i * sizeof (uint32_t);
+ if (pgm_read_dword_far (pf) != get_val (i))
+__builtin_exit (__LINE__);
+}
+
+int main (void)
+{
+ test (1);
+ test (2);
+ return 0;
+}
+
+#else
+int main (void)
+{
+ return 0;
+}
+#endif
[gcc r15-7542] nvptx: Set 'UI_TARGET' for 'TARGET_EXCEPT_UNWIND_INFO' [PR86660]
https://gcc.gnu.org/g:9611ce687904a22da2febbc97acba2ae0f0c3780
commit r15-7542-g9611ce687904a22da2febbc97acba2ae0f0c3780
Author: Thomas Schwinge
Date: Tue Feb 11 17:23:28 2025 +0100
nvptx: Set 'UI_TARGET' for 'TARGET_EXCEPT_UNWIND_INFO' [PR86660]
Subversion r263265 (Git commit 77e0a97acf7b00c1e68e4738fdf275a4cffc2e50)
"[nvptx] Ignore c++ exceptions", originally had set 'UI_TARGET', but as
part of
Subversion r263287 (Git commit d989dba8ef02c2406b7c9e62b352197dffc6b880)
"[c++] Don't emit exception tables for UI_NONE", then switched to 'UI_NONE'.
I understand the intention of using 'UI_NONE' like this, and it happens to
work
in a lot of cases, but there are ICEs elsewhere: code paths where we run
into
'internal compiler error: in get_personality_function, at expr.cc:13512':
13494 /* Extracts the personality function of DECL and returns the
corresponding
13495libfunc. */
13496
13497 rtx
13498 get_personality_function (tree decl)
13499 {
13500 tree personality = DECL_FUNCTION_PERSONALITY (decl);
13501 enum eh_personality_kind pk;
13502
13503 pk = function_needs_eh_personality (DECL_STRUCT_FUNCTION
(decl));
13504 if (pk == eh_personality_none)
13505 return NULL;
13506
13507 if (!personality
13508 && pk == eh_personality_any)
13509 personality = lang_hooks.eh_personality ();
13510
13511 if (pk == eh_personality_lang)
13512 gcc_assert (personality != NULL_TREE);
13513
13514 return XEXP (DECL_RTL (personality), 0);
13515 }
..., where 'lang_hooks.eh_personality ()' ends up calling
'gcc/expr.cc:build_personality_function', and we 'return NULL;' for
'UI_NONE':
13448 /* Build a decl for a personality function given a language
prefix. */
13449
13450 tree
13451 build_personality_function (const char *lang)
13452 {
13453 const char *unwind_and_version;
13454 tree decl, type;
13455 char *name;
13456
13457 switch (targetm_common.except_unwind_info (&global_options))
13458 {
13459 case UI_NONE:
13460 return NULL;
[...]
(Comparing to nvptx' current use of 'UI_NONE', this problem (ICEs mentioned
above) is way more prevalent for GCN.)
The GCC internals documentation indeed states, 'gcc/doc/tm.texi':
@deftypefn {Common Target Hook} {enum unwind_info_type}
TARGET_EXCEPT_UNWIND_INFO (struct gcc_options *@var{opts})
This hook defines the mechanism that will be used for exception handling
by the target. If the target has ABI specified unwind tables, the hook
should return @code{UI_TARGET}. If the target is to use the
@code{setjmp}/@code{longjmp}-based exception handling scheme, the hook
should return @code{UI_SJLJ}. If the target supports DWARF 2 frame
unwind
information, the hook should return @code{UI_DWARF2}.
A target may, if exceptions are disabled, choose to return
@code{UI_NONE}.
This may end up simplifying other parts of target-specific code. [...]
Here, note: "if exceptions are disabled" (meaning: '-fno-exceptions' etc.)
may
"return @code{UI_NONE}". That's what other back ends do with code like:
/* For simplicity elsewhere in this file, indicate that all unwind
info is disabled if we're not emitting unwind tables. */
if (!opts->x_flag_exceptions && !opts->x_flag_unwind_tables)
return UI_NONE;
else
return UI_TARGET;
The corresponding "simplifying other parts of target-specific code"/
"simplicity elsewhere" would then be the early returns from
'TARGET_ASM_UNWIND_EMIT', 'ARM_OUTPUT_FN_UNWIND', etc. for
'TARGET_EXCEPT_UNWIND_INFO != UI_TARGET' (that is, for 'UI_NONE').
From the documentation (and implementation), however, it does *not* follow
that
if a target doesn't implement support for exception handling, it may just
set
'UI_NONE' for 'TARGET_EXCEPT_UNWIND_INFO'.
Therefore, switch (back) to 'UI_TARGET', implementing some basic support for
'exception_section': discard (via a PTX comment block) whatever GCC writes
into
it.
With that, all these 'internal compiler error: in get_personality_function'
test cases turn into PASS, or UNSUPPORTED ('exception handling not
supported'),
or re-classify into a few other, already known issues.
(In case that use of 'UI_NONE' like originally intended really makes sense,
and
is preferable over this 'UI_TARGET' solution, then more work will be
necessary
for implementing the missing parts, where 'UI_NONE' currently isn't
handled.)
PR target/86660
gcc/
* common/c
[gcc r15-7541] nvptx: Sanity-check 'init_frag' state
https://gcc.gnu.org/g:79cb26298c76f1360f1aada26863f011c4decc34
commit r15-7541-g79cb26298c76f1360f1aada26863f011c4decc34
Author: Thomas Schwinge
Date: Thu Feb 13 00:35:31 2025 +0100
nvptx: Sanity-check 'init_frag' state
The 'init_frag' machinery is used by 'nvptx_assemble_integer' (via
'TARGET_ASM_INTEGER'), 'nvptx_output_skip' (via 'ASM_OUTPUT_SKIP'),
'nvptx_output_ascii' (via 'ASM_OUTPUT_ASCII'). But, it's not obvious that
these are called only when that machinery is active (and in a consistent
state), which it only is in 'nvptx_output_aligned_decl' (via
'ASM_OUTPUT_ALIGNED_DECL_COMMON', or 'ASM_OUTPUT_ALIGNED_DECL_LOCAL'), or in
'nvptx_assemble_undefined_decl' (via 'TARGET_ASM_ASSEMBLE_UNDEFINED_DECL'),
or
within a region started by 'nvptx_assemble_decl_begin' (via
'nvptx_asm_declare_constant_name' (via 'TARGET_ASM_DECLARE_CONSTANT_NAME'),
or
via 'nvptx_declare_object_name' (via 'ASM_DECLARE_OBJECT_NAME')) and ended
by
'nvptx_assemble_decl_end' (via 'TARGET_ASM_DECL_END').
And indeed, in a GCC/nvptx offloading configuration, we then find that
'nvptx_output_skip' (via 'ASM_OUTPUT_SKIP') is getting called in
inconsistent
'init_frag' state, in 'gcc/varasm.cc', via 'assemble_zeros', from
'output_object_block', to "Move to the object's offset, padding with zeros".
Supposedly, this didn't cause any damage, but we now handle it explicitly.
(..., and the question remains whether such "padding" etc. shouldn't
actually
be attempted for targets like nvptx.)
gcc/
* config/nvptx/nvptx.cc (init_frag): New 'bool active' member.
(output_init_frag, nvptx_assemble_value, nvptx_assemble_integer)
(nvptx_output_skip, nvptx_assemble_decl_begin)
(nvptx_assemble_decl_end): Sanity-check its state.
Diff:
---
gcc/config/nvptx/nvptx.cc | 26 ++
1 file changed, 26 insertions(+)
diff --git a/gcc/config/nvptx/nvptx.cc b/gcc/config/nvptx/nvptx.cc
index 6f3646192056..96f258c5573d 100644
--- a/gcc/config/nvptx/nvptx.cc
+++ b/gcc/config/nvptx/nvptx.cc
@@ -2255,6 +2255,7 @@ static struct
out. */
unsigned size; /* Fragment size to accumulate. */
unsigned offset; /* Offset within current fragment. */
+ bool active; /* Whether this machinery is active. */
bool started; /* Whether we've output any initializer. */
} init_frag;
@@ -2265,6 +2266,8 @@ static struct
static void
output_init_frag (rtx sym)
{
+ gcc_checking_assert (init_frag.active);
+
fprintf (asm_out_file, init_frag.started ? ", " : " = { ");
unsigned HOST_WIDE_INT val = init_frag.val;
@@ -2296,6 +2299,8 @@ output_init_frag (rtx sym)
static void
nvptx_assemble_value (unsigned HOST_WIDE_INT val, unsigned size)
{
+ gcc_checking_assert (init_frag.active);
+
bool negative_p
= val & (HOST_WIDE_INT_1U << (HOST_BITS_PER_WIDE_INT - 1));
@@ -2328,6 +2333,8 @@ nvptx_assemble_value (unsigned HOST_WIDE_INT val,
unsigned size)
static bool
nvptx_assemble_integer (rtx x, unsigned int size, int ARG_UNUSED (aligned_p))
{
+ gcc_checking_assert (init_frag.active);
+
HOST_WIDE_INT val = 0;
switch (GET_CODE (x))
@@ -2370,6 +2377,17 @@ nvptx_assemble_integer (rtx x, unsigned int size, int
ARG_UNUSED (aligned_p))
void
nvptx_output_skip (FILE *, unsigned HOST_WIDE_INT size)
{
+ gcc_checking_assert (in_section == data_section
+ || in_section == text_section);
+
+ if (!init_frag.active)
+/* We're in the 'data_section' or 'text_section', outside of an
+ initializer context ('init_frag'). There's nothing to do here:
+ in PTX, there's no concept of an assembler's "location counter",
+ "current address", "dot symbol" ('.') that might need padding or
+ aligning. */
+return;
+
/* Finish the current fragment, if it's started. */
if (init_frag.offset)
{
@@ -2446,6 +2464,8 @@ nvptx_assemble_decl_begin (FILE *file, const char *name,
const char *section,
const_tree type, HOST_WIDE_INT size, unsigned align,
bool undefined = false)
{
+ gcc_checking_assert (!init_frag.active);
+
bool atype = (TREE_CODE (type) == ARRAY_TYPE)
&& (TYPE_DOMAIN (type) == NULL_TREE);
@@ -2473,6 +2493,8 @@ nvptx_assemble_decl_begin (FILE *file, const char *name,
const char *section,
elt_size |= GET_MODE_SIZE (elt_mode);
elt_size &= -elt_size; /* Extract LSB set. */
+ init_frag.active = true;
+
init_frag.size = elt_size;
/* Avoid undefined shift behavior by using '2'. */
init_frag.mask = ((unsigned HOST_WIDE_INT)2
@@ -2504,10 +2526,14 @@ nvptx_assemble_decl_begin (FILE *file, const char
*name, const char *section,
static void
nvptx_assemble_decl_end (void)
{
+ gcc_checking_assert (init_frag.active);
+
if (init_frag.offset)
/* This can happen with a packed struct with trailing array member.
[gcc r15-7540] nvptx: Clarify 'nvptx_output_skip' case of no or incomplete initializer
https://gcc.gnu.org/g:09b207bf26b9c79a43e1a346a4493d4b202b4ac5
commit r15-7540-g09b207bf26b9c79a43e1a346a4493d4b202b4ac5
Author: Thomas Schwinge
Date: Thu Feb 13 22:58:21 2025 +0100
nvptx: Clarify 'nvptx_output_skip' case of no or incomplete initializer
I was getting confused about 'nvptx_output_skip' in certain cases not doing
anything at all; write down and 'assert' what I found.
gcc/
* config/nvptx/nvptx.cc (nvptx_output_skip): Clarify case of
no or incomplete initializer.
Diff:
---
gcc/config/nvptx/nvptx.cc | 6 ++
1 file changed, 6 insertions(+)
diff --git a/gcc/config/nvptx/nvptx.cc b/gcc/config/nvptx/nvptx.cc
index 060f45318f45..6f3646192056 100644
--- a/gcc/config/nvptx/nvptx.cc
+++ b/gcc/config/nvptx/nvptx.cc
@@ -2391,6 +2391,12 @@ nvptx_output_skip (FILE *, unsigned HOST_WIDE_INT size)
if (size)
nvptx_assemble_value (0, size);
}
+ else
+/* Otherwise, we don't have to do anything: this skip terminates the
+ initializer; we skip either the full ('!init_frag.started' case) or the
+ remainder ('init_frag.started' case) of the initializer (that is, either
+ no or incomplete initializer). */
+gcc_checking_assert (size == init_frag.remaining * init_frag.size);
}
/* Output a string STR with length SIZE. As in nvptx_output_skip we
[gcc r15-7543] GCN: Set 'UI_TARGET' for 'TARGET_EXCEPT_UNWIND_INFO' [PR94282, PR113331]
https://gcc.gnu.org/g:2b9bdb2d286e6872f4195ba2e710130cf6b2805d
commit r15-7543-g2b9bdb2d286e6872f4195ba2e710130cf6b2805d
Author: Thomas Schwinge
Date: Tue Feb 11 17:23:28 2025 +0100
GCN: Set 'UI_TARGET' for 'TARGET_EXCEPT_UNWIND_INFO' [PR94282, PR113331]
In commit 7f1989249e25af6fc0f124452efa24b3796b767a
"[gcn] Set 'UI_NONE' for 'TARGET_EXCEPT_UNWIND_INFO' [PR94282]", we've
copied
the 'UI_NONE' idea from nvptx to GCN.
I understand the intention of using 'UI_NONE' like this, and it happens to
work
in a lot of cases, but there are ICEs elsewhere: code paths where we run
into
'internal compiler error: in get_personality_function, at expr.cc:13512':
13494 /* Extracts the personality function of DECL and returns the
corresponding
13495libfunc. */
13496
13497 rtx
13498 get_personality_function (tree decl)
13499 {
13500 tree personality = DECL_FUNCTION_PERSONALITY (decl);
13501 enum eh_personality_kind pk;
13502
13503 pk = function_needs_eh_personality (DECL_STRUCT_FUNCTION
(decl));
13504 if (pk == eh_personality_none)
13505 return NULL;
13506
13507 if (!personality
13508 && pk == eh_personality_any)
13509 personality = lang_hooks.eh_personality ();
13510
13511 if (pk == eh_personality_lang)
13512 gcc_assert (personality != NULL_TREE);
13513
13514 return XEXP (DECL_RTL (personality), 0);
13515 }
..., where 'lang_hooks.eh_personality ()' ends up calling
'gcc/expr.cc:build_personality_function', and we 'return NULL;' for
'UI_NONE':
13448 /* Build a decl for a personality function given a language
prefix. */
13449
13450 tree
13451 build_personality_function (const char *lang)
13452 {
13453 const char *unwind_and_version;
13454 tree decl, type;
13455 char *name;
13456
13457 switch (targetm_common.except_unwind_info (&global_options))
13458 {
13459 case UI_NONE:
13460 return NULL;
[...]
(Comparing to nvptx' current use of 'UI_NONE', this problem (ICEs mentioned
above) is way more prevalent for GCN.)
The GCC internals documentation indeed states, 'gcc/doc/tm.texi':
@deftypefn {Common Target Hook} {enum unwind_info_type}
TARGET_EXCEPT_UNWIND_INFO (struct gcc_options *@var{opts})
This hook defines the mechanism that will be used for exception handling
by the target. If the target has ABI specified unwind tables, the hook
should return @code{UI_TARGET}. If the target is to use the
@code{setjmp}/@code{longjmp}-based exception handling scheme, the hook
should return @code{UI_SJLJ}. If the target supports DWARF 2 frame
unwind
information, the hook should return @code{UI_DWARF2}.
A target may, if exceptions are disabled, choose to return
@code{UI_NONE}.
This may end up simplifying other parts of target-specific code. [...]
Here, note: "if exceptions are disabled" (meaning: '-fno-exceptions' etc.)
may
"return @code{UI_NONE}". That's what other back ends do with code like:
/* For simplicity elsewhere in this file, indicate that all unwind
info is disabled if we're not emitting unwind tables. */
if (!opts->x_flag_exceptions && !opts->x_flag_unwind_tables)
return UI_NONE;
else
return UI_TARGET;
The corresponding "simplifying other parts of target-specific code"/
"simplicity elsewhere" would then be the early returns from
'TARGET_ASM_UNWIND_EMIT', 'ARM_OUTPUT_FN_UNWIND', etc. for
'TARGET_EXCEPT_UNWIND_INFO != UI_TARGET' (that is, for 'UI_NONE').
From the documentation (and implementation), however, it does *not* follow
that
if a target doesn't implement support for exception handling, it may just
set
'UI_NONE' for 'TARGET_EXCEPT_UNWIND_INFO'.
Therefore, switch to 'UI_TARGET', allocating a "fake" 'exception_section'.
With that, all these 'internal compiler error: in get_personality_function'
test cases turn into PASS, or UNSUPPORTED ('exception handling not
supported'),
or re-classify into a few other, already known issues. And, this change
also
happens to resolve the class of errors identified in GCC PR113331
"AMDGCN: Compilation failure due to duplicate .LEHB/.LEHE symbols".
(In case that use of 'UI_NONE' like originally intended really makes sense,
and
is preferable over this 'UI_TARGET' solution, then more work will be
necessary
for implementing the missing parts, where 'UI_NONE' currently isn't
handled.)
PR target/94282
PR target/113331
gcc/
* common/config/gcn/gcn-common.cc (gcn_exc
[gcc r15-7546] c++: add fixed test [PR83144]
https://gcc.gnu.org/g:8e44f7ecb7b9ad6893f7784b1a303a5463b46cd5
commit r15-7546-g8e44f7ecb7b9ad6893f7784b1a303a5463b46cd5
Author: Marek Polacek
Date: Fri Feb 14 17:29:27 2025 -0500
c++: add fixed test [PR83144]
Fixed by r12-4425 and it seemed worth adding.
PR c++/83144
gcc/testsuite/ChangeLog:
* g++.dg/cpp0x/constexpr-83144.C: New test.
Diff:
---
gcc/testsuite/g++.dg/cpp0x/constexpr-83144.C | 21 +
1 file changed, 21 insertions(+)
diff --git a/gcc/testsuite/g++.dg/cpp0x/constexpr-83144.C
b/gcc/testsuite/g++.dg/cpp0x/constexpr-83144.C
new file mode 100644
index ..858fec13a2c8
--- /dev/null
+++ b/gcc/testsuite/g++.dg/cpp0x/constexpr-83144.C
@@ -0,0 +1,21 @@
+// PR c++/83144
+// { dg-do compile { target c++11 } }
+
+template class tuple;
+struct _Head_base {
+ int _M_head_impl;
+};
+template struct _Tuple_impl;
+template
+struct _Tuple_impl<_Idx, _Head, _Tail...> : _Head_base {};
+template
+struct tuple<_T1, _T2> : _Tuple_impl<0, _T2> {
+ template tuple(_U1, _U2);
+};
+template void get(tuple<_Elements...>);
+template struct interval_t : tuple {
+ using tuple::tuple;
+ constexpr T last() { get<1>(*this); }
+ auto size() -> decltype(last() - 0);
+};
+int main(int argc, char **) { interval_t{2, argc}; }
[gcc r15-7545] c++: assign the result of force_paren_expr
https://gcc.gnu.org/g:e4c9e1094405612feae410e133025e3267331c2d commit r15-7545-ge4c9e1094405612feae410e133025e3267331c2d Author: Marek Polacek Date: Fri Feb 14 17:21:31 2025 -0500 c++: assign the result of force_paren_expr gcc/cp/ChangeLog: * pt.cc (tsubst_expr) : Assign the result of force_paren_expr. Diff: --- gcc/cp/pt.cc | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/gcc/cp/pt.cc b/gcc/cp/pt.cc index 5706a3987c34..62d91a2dd159 100644 --- a/gcc/cp/pt.cc +++ b/gcc/cp/pt.cc @@ -21713,7 +21713,7 @@ tsubst_expr (tree t, tree args, tsubst_flags_t complain, tree in_decl) r = finish_non_static_data_member (member, object, NULL_TREE, complain); if (REF_PARENTHESIZED_P (t)) - force_paren_expr (r); + r = force_paren_expr (r); RETURN (r); } else if (type_dependent_expression_p (object))
[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: a7d30957412c... Déplacement fonction
[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(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)] 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)] 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(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)] 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] 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: e8d300a99c04... Déplacement fonction Diff: !!! WARNING: THE FOLLOWING COMMITS ARE NO LONGER ACCESSIBLE (LOST): --- e8d300a... Déplacement fonction cbb7977... Factorisation shift_descriptor 2e7ed30... Correction typo 305e39d... Factorisation set_descriptor_dimension cf483b5... Correction régression class_transformational_2 d8e509d... Réduction différences 61b45d5... Suppression code redondant initialisation descriptor tempor bcdea6a... Factorisation set temporary descriptor e10f619... Correction erreurs non-lvalue lhs pr113363.f90 18adfe8... Ajout surcharge gfc_conv_descriptor_type_set 0533730... Correction non_lvalue PR97046.f90 0f4d403... git commit correction erreur gimplify 6a9e70e... Interdiction non-lvalue as lhs ca55548... Mise à jour dump contiguous_3.f90 d130e5d... Mise à jour dump coarray_lib_token_2.f90 19c7720... Mise à jour dump coarray_lib_token_3.f90 4c58f11... Mise à jour dump coarray_lib_token_4.f90 79013ea... Mise à jour dump coarray_lib_alloc_1.f90 3e36fe8... Mise à jour dump coarray_lib_alloc_3.f90 6ec... Mise à jour dump coarray_lib_alloc_2.f90 37a7e66... Mise à jour dump coarray_lib_alloc_4.f90 c490d4b... Correction dump coarray_allocate_7.f08 35716cd... Mise à jour dump coarray_lock_7.f90 93cb38c... Mise à jour dumps coarray_poly_*.f90 5565aa2... Mise à jour dump bind-c-contiguous-2.f90 278b414... match: Unwrap non-lvalue as unary or binary operand f22fec6... match: Simplify double not and double negate to a non_lvalu 4a81633... Correction ICE coarray_42.f90 ef90284... Correction régression assumed_rank_7.f90 ac595ff... Correction régression realloc on assign (associate_61, ... 3938b37... Introduction getters et setters descriptor compil' OK ad8f09d... Correction régression realloc_on_assign_12.f90 3fa2826... Factorisation initialisation dimension descripteur 89ff0d9... Factorisation set_descriptor_dimension b253d45... Factorisation gfc_conv_shift_descriptor 96c395b... Renseignement token par gfc_set_descriptor_from_scalar. cd99fad... Séparation motifs dump assumed_rank_12.f90 ac8ccbd... Annulation modif dump assumed_rank_12.f90 34baff5... Sauvegarde factorisation set_descriptor_from_scalar 47b6338... Déplacement gfc_set_gfc_from_cfi d292794... Déplacement gfc_copy_sequence_descriptor da0f060... 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(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)] 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)] 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 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)] 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)] 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 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 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)] 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)] 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)] 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)] 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)] 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)] 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)] 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 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)] 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)] 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)] Sauvegarde factorisation set_descriptor_from_scalar
https://gcc.gnu.org/g:3e14437bb7d46a96bc507cbb41bd91e44b34ee77
commit 3e14437bb7d46a96bc507cbb41bd91e44b34ee77
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)] Déplacement gfc_copy_sequence_descriptor
https://gcc.gnu.org/g:f634a20a43b04a7f9993caa37af123d9a02ba7ff
commit f634a20a43b04a7f9993caa37af123d9a02ba7ff
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)] Déplacement gfc_set_gfc_from_cfi
https://gcc.gnu.org/g:c980269c8043debd82e75a01b623d7279088402a
commit c980269c8043debd82e75a01b623d7279088402a
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)] Déplacement méthode set_descriptor_from_scalar
https://gcc.gnu.org/g:9652121cbd1968be55401f85dab5b3bf5a178cdd
commit 9652121cbd1968be55401f85dab5b3bf5a178cdd
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)] Introduction getters et setters descriptor compil' OK
https://gcc.gnu.org/g:bed2485b5e68eb56ceaee133594eae256cbaf215
commit bed2485b5e68eb56ceaee133594eae256cbaf215
Author: Mikael Morin
Date: Mon Feb 10 19:24:59 2025 +0100
Introduction getters et setters descriptor compil' OK
Correction régression realloc on assign (associate_61, ...)
Correction régression assumed_rank_7.f90
Correction ICE coarray_42.f90
Diff:
---
gcc/fortran/trans-array.cc | 817 +
gcc/fortran/trans-array.h | 26 +-
gcc/fortran/trans-decl.cc | 8 +-
gcc/fortran/trans-expr.cc | 66 ++--
gcc/fortran/trans-intrinsic.cc | 61 ++-
gcc/fortran/trans-openmp.cc| 2 +-
gcc/fortran/trans-stmt.cc | 7 +-
gcc/fortran/trans.cc | 7 +-
8 files changed, 671 insertions(+), 323 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index e60204ae3ee2..7072927a30be 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -242,8 +242,15 @@ gfc_get_cfi_dim_sm (tree desc, tree idx)
#define LBOUND_SUBFIELD 1
#define UBOUND_SUBFIELD 2
-static tree
-gfc_get_descriptor_field (tree desc, unsigned field_idx)
+
+namespace gfc_descriptor
+{
+
+namespace
+{
+
+tree
+get_field (tree desc, unsigned field_idx)
{
tree type = TREE_TYPE (desc);
gcc_assert (GFC_DESCRIPTOR_TYPE_P (type));
@@ -251,111 +258,119 @@ gfc_get_descriptor_field (tree desc, unsigned field_idx)
tree field = gfc_advance_chain (TYPE_FIELDS (type), field_idx);
gcc_assert (field != NULL_TREE);
+ return field;
+}
+
+tree
+get_component (tree desc, unsigned field_idx)
+{
+ tree field = get_field (desc, field_idx);
+
return fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (field),
desc, field, NULL_TREE);
}
-/* This provides READ-ONLY access to the data field. The field itself
- doesn't have the proper type. */
+tree
+get_data (tree desc)
+{
+ return get_component (desc, DATA_FIELD);
+}
tree
-gfc_conv_descriptor_data_get (tree desc)
+conv_data_get (tree desc)
{
tree type = TREE_TYPE (desc);
- if (TREE_CODE (type) == REFERENCE_TYPE)
-gcc_unreachable ();
+ gcc_assert (TREE_CODE (type) != REFERENCE_TYPE);
- tree field = gfc_get_descriptor_field (desc, DATA_FIELD);
- return fold_convert (GFC_TYPE_ARRAY_DATAPTR_TYPE (type), field);
+ tree field = get_data (desc);
+ tree t = fold_convert (GFC_TYPE_ARRAY_DATAPTR_TYPE (type), field);
+ return non_lvalue_loc (input_location, t);
}
-/* This provides WRITE access to the data field.
-
- TUPLES_P is true if we are generating tuples.
-
- This function gets called through the following macros:
- gfc_conv_descriptor_data_set
- gfc_conv_descriptor_data_set. */
-
void
-gfc_conv_descriptor_data_set (stmtblock_t *block, tree desc, tree value)
+conv_data_set (stmtblock_t *block, tree desc, tree value)
{
- tree field = gfc_get_descriptor_field (desc, DATA_FIELD);
+ tree field = get_data (desc);
gfc_add_modify (block, field, fold_convert (TREE_TYPE (field), value));
}
-
-/* This provides address access to the data field. This should only be
- used by array allocation, passing this on to the runtime. */
-
tree
-gfc_conv_descriptor_data_addr (tree desc)
+conv_data_addr (tree desc)
{
- tree field = gfc_get_descriptor_field (desc, DATA_FIELD);
+ tree field = get_data (desc);
return gfc_build_addr_expr (NULL_TREE, field);
}
-static tree
-gfc_conv_descriptor_offset (tree desc)
+tree
+get_offset (tree desc)
{
- tree field = gfc_get_descriptor_field (desc, OFFSET_FIELD);
+ tree field = get_component (desc, OFFSET_FIELD);
gcc_assert (TREE_TYPE (field) == gfc_array_index_type);
return field;
}
tree
-gfc_conv_descriptor_offset_get (tree desc)
+conv_offset_get (tree desc)
{
- return gfc_conv_descriptor_offset (desc);
+ return non_lvalue_loc (input_location, get_offset (desc));
}
void
-gfc_conv_descriptor_offset_set (stmtblock_t *block, tree desc,
- tree value)
+conv_offset_set (stmtblock_t *block, tree desc, tree value)
{
- tree t = gfc_conv_descriptor_offset (desc);
+ tree t = get_offset (desc);
gfc_add_modify (block, t, fold_convert (TREE_TYPE (t), value));
}
-
tree
-gfc_conv_descriptor_dtype (tree desc)
+get_dtype (tree desc)
{
- tree field = gfc_get_descriptor_field (desc, DTYPE_FIELD);
+ tree field = get_component (desc, DTYPE_FIELD);
gcc_assert (TREE_TYPE (field) == get_dtype_type_node ());
return field;
}
-static tree
-gfc_conv_descriptor_span (tree desc)
+tree
+conv_dtype_get (tree desc)
+{
+ return non_lvalue_loc (input_location, get_dtype (desc));
+}
+
+void
+conv_dtype_set (stmtblock_t *block, tree desc, tree val)
+{
+ tree t = get_dtype (desc);
+ gfc_add_modify (block, t, val);
+}
+
+tree
+get_span (tree desc)
{
- tree field = gfc_get_descriptor_field (desc, SPAN_FIELD);
+ tree field = get_component (desc, SPAN_FIELD);
gcc_assert (TREE_TYPE (field) == gfc_arra
[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] Mises à jour dumps
https://gcc.gnu.org/g:62bf6ea09a684d80ab4ac2b406ce62460d0425a1
commit 62bf6ea09a684d80ab4ac2b406ce62460d0425a1
Author: Mikael Morin
Date: Tue Feb 11 18:07:23 2025 +0100
Mises à jour dumps
Mise à jour dump bind-c-contiguous-2.f90
Mise à jour dumps coarray_poly_*.f90
Mise à jour dump coarray_lock_7.f90
Correction dump coarray_allocate_7.f08
Mise à jour dump coarray_lib_alloc_4.f90
Mise à jour dump coarray_lib_alloc_2.f90
Mise à jour dump coarray_lib_alloc_3.f90
Mise à jour dump coarray_lib_alloc_1.f90
Mise à jour dump coarray_lib_token_4.f90
Mise à jour dump coarray_lib_token_3.f90
Mise à jour dump coarray_lib_token_2.f90
Mise à jour dump contiguous_3.f90
Diff:
---
gcc/testsuite/gfortran.dg/bind-c-contiguous-2.f90 | 12 ++--
gcc/testsuite/gfortran.dg/coarray_allocate_7.f08 | 2 +-
gcc/testsuite/gfortran.dg/coarray_lib_alloc_1.f90 | 12 ++--
gcc/testsuite/gfortran.dg/coarray_lib_alloc_2.f90 | 12 ++--
gcc/testsuite/gfortran.dg/coarray_lib_alloc_3.f90 | 12 ++--
gcc/testsuite/gfortran.dg/coarray_lib_alloc_4.f90 | 8
gcc/testsuite/gfortran.dg/coarray_lib_token_2.f90 | 4 ++--
gcc/testsuite/gfortran.dg/coarray_lib_token_3.f90 | 4 ++--
gcc/testsuite/gfortran.dg/coarray_lib_token_4.f90 | 6 +++---
gcc/testsuite/gfortran.dg/coarray_lock_7.f90 | 12 ++--
gcc/testsuite/gfortran.dg/coarray_poly_4.f90 | 2 +-
gcc/testsuite/gfortran.dg/coarray_poly_5.f90 | 2 +-
gcc/testsuite/gfortran.dg/coarray_poly_6.f90 | 2 +-
gcc/testsuite/gfortran.dg/coarray_poly_7.f90 | 2 +-
gcc/testsuite/gfortran.dg/coarray_poly_8.f90 | 2 +-
gcc/testsuite/gfortran.dg/contiguous_3.f90| 4 ++--
16 files changed, 49 insertions(+), 49 deletions(-)
diff --git a/gcc/testsuite/gfortran.dg/bind-c-contiguous-2.f90
b/gcc/testsuite/gfortran.dg/bind-c-contiguous-2.f90
index 5b546800e7ff..243c4a57cba4 100644
--- a/gcc/testsuite/gfortran.dg/bind-c-contiguous-2.f90
+++ b/gcc/testsuite/gfortran.dg/bind-c-contiguous-2.f90
@@ -60,12 +60,12 @@ end
! Copy in + out
-! { dg-final { scan-tree-dump-times "__builtin_memcpy \\(\\(void \\*\\)
xx->data \\+ xx->dtype.elem_len \\* arrayidx.\[0-9\]+, _xx->base_addr \\+
shift.\[0-9\]+, xx->dtype.elem_len\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times {__builtin_memcpy \(\(void \*\) xx->data
\+ xx->dtype.elem_len \* arrayidx.[0-9]+, _xx->base_addr \+ shift.[0-9]+,
(?:NON_LVALUE_EXPR <)?xx->dtype.elem_len>?\);} 1 "original" } }
! { dg-final { scan-tree-dump-times "xx->data = \\(void \\* restrict\\)
_xx->base_addr;" 1 "original" } }
-! { dg-final { scan-tree-dump-times "__builtin_memcpy \\(\\(void \\*\\)
xx->data \\+ xx->dtype.elem_len \\* arrayidx.\[0-9\]+, _xx->base_addr \\+
shift.\[0-9\]+, xx->dtype.elem_len\\);" 1 "original" } }
-! { dg-final { scan-tree-dump-times "__builtin_memcpy \\(\\(void \\*\\)
yy->data \\+ yy->dtype.elem_len \\* arrayidx.\[0-9\]+, _yy->base_addr \\+
shift.\[0-9\]+, yy->dtype.elem_len\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times {__builtin_memcpy \(\(void \*\) xx->data
\+ xx->dtype.elem_len \* arrayidx.[0-9]+, _xx->base_addr \+ shift.[0-9]+,
(?:NON_LVALUE_EXPR <)?xx->dtype.elem_len>?\);} 1 "original" } }
+! { dg-final { scan-tree-dump-times {__builtin_memcpy \(\(void \*\) yy->data
\+ yy->dtype.elem_len \* arrayidx.[0-9]+, _yy->base_addr \+ shift.[0-9]+,
(?:NON_LVALUE_EXPR <)?yy->dtype.elem_len>?\);} 1 "original" } }
! { dg-final { scan-tree-dump-times "yy->data = \\(void \\* restrict\\)
_yy->base_addr;" 1 "original" } }
-! { dg-final { scan-tree-dump-times "__builtin_memcpy \\(_yy->base_addr \\+
shift.\[0-9\]+, \\(void \\*\\) yy->data \\+ yy->dtype.elem_len \\*
arrayidx.\[0-9\]+, yy->dtype.elem_len\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times {__builtin_memcpy \(_yy->base_addr \+
shift.[0-9]+, \(void \*\) yy->data \+ yy->dtype.elem_len \* arrayidx.[0-9]+,
(?:NON_LVALUE_EXPR <)?yy->dtype.elem_len>?\);} 1 "original" } }
! { dg-final { scan-tree-dump-times "zz =
\\(character\\(kind=1\\)\\\[0:\\\]\\\[1:zz.\[0-9\]+\\\] \\* restrict\\)
_zz->base_addr;" 1 "original" } }
! { dg-final { scan-tree-dump-times "__builtin_memcpy \\(\\(void \\*\\) zz \\+
_zz->elem_len \\* arrayidx.\[0-9\]+, _zz->base_addr \\+ shift.\[0-9\]+,
_zz->elem_len\\);" 1 "original" } }
@@ -73,10 +73,10 @@ end
! Copy in only
-! { dg-final { scan-tree-dump-times "__builtin_memcpy \\(\\(void \\*\\)
aa->data \\+ aa->dtype.elem_len \\* arrayidx.\[0-9\]+, _aa->base_addr \\+
shift.\[0-9\]+, aa->dtype.elem_len\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times {__builtin_memcpy \(\(void \*\) aa->data
\+ aa->dtype.elem_len \* arrayidx.[0-9]+, _aa->base_addr \+ shift.[0-9]+,
(?:NON_LVALUE_EXPR <)?aa->dtype.elem_len>?\);} 1 "original" } }
! { dg-final { scan-tree-dump-times "aa->data = \\(void \\* restrict\\)
_aa->base_addr;" 1 "original" } }
[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] Factorisation gfc_conv_shift_descriptor
https://gcc.gnu.org/g:c55b04c7f241e7439c0f49b1762f8ebdea663073
commit c55b04c7f241e7439c0f49b1762f8ebdea663073
Author: Mikael Morin
Date: Thu Feb 6 17:16:13 2025 +0100
Factorisation gfc_conv_shift_descriptor
Correction compil'
Correction régression allocated_4.f90
Factorisation gfc_conv_shift_descriptor.
Correction régression allocated_4.f90
Modifications mineures
Correction régression bound_10.f90
Correction régression alloc_comp_constructor_1.f90
Correction régression realloc_on_assign_10
Revert "Correction régression realloc_on_assign_10"
This reverts commit 007ca869933eb74b76398200ef0237219ba01cd8.
Correction régression realloc_on_assign_11.f90
Diff:
---
gcc/fortran/trans-array.cc | 165 ++---
gcc/fortran/trans-expr.cc | 15 -
2 files changed, 94 insertions(+), 86 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index c09b9bdab155..a33422efa55f 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -1476,35 +1476,43 @@ 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,
- tree new_lbound, tree offset)
+conv_shift_descriptor_lbound (stmtblock_t* block, tree from_desc, tree
to_desc, int dim,
+ tree new_lbound, tree offset, bool zero_based)
{
- tree ubound, lbound, stride;
- tree diff, offs_diff;
-
new_lbound = fold_convert (gfc_array_index_type, new_lbound);
+ new_lbound = gfc_evaluate_now (new_lbound, block);
- 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]);
+ 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;
+ if (zero_based)
+diff = new_lbound;
+ else
+{
+ /* Get difference (new - old) by which to shift stuff. */
+ diff = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
+ new_lbound, lbound);
+ diff = gfc_evaluate_now (diff, block);
+}
/* 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, 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,
- offset, offs_diff);
- gfc_add_modify (block, offset, tmp);
+ tree tmp1 = 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], tmp1);
+ /* Set lbound to the value we want. */
+ gfc_conv_descriptor_lbound_set (block, to_desc, gfc_rank_cst[dim],
new_lbound);
- /* Finally set lbound to value we want. */
- gfc_conv_descriptor_lbound_set (block, desc, gfc_rank_cst[dim], new_lbound);
+ tree offs_diff = fold_build2_loc (input_location, MULT_EXPR,
gfc_array_index_type,
+ diff, stride);
+ tree tmp2 = fold_build2_loc (input_location, MINUS_EXPR,
gfc_array_index_type,
+ offset, offs_diff);
+ gfc_add_modify (block, offset, tmp2);
+
+ if (from_desc != to_desc)
+gfc_conv_descriptor_stride_set (block, to_desc, gfc_rank_cst[dim], stride);
}
@@ -1512,6 +1520,7 @@ class lb_info_base
{
public:
virtual tree lower_bound (stmtblock_t *block, int dim) const = 0;
+ virtual bool zero_based_src () const { return false; }
};
@@ -1572,21 +1581,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_va
[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] Factorisation set_descriptor_dimension
https://gcc.gnu.org/g:bf057de23fdec616404bbe9ca73384463f5077c2
commit bf057de23fdec616404bbe9ca73384463f5077c2
Author: Mikael Morin
Date: Fri Feb 7 12:07:36 2025 +0100
Factorisation set_descriptor_dimension
Correction compil'
Diff:
---
gcc/fortran/trans-array.cc | 82 +-
1 file changed, 44 insertions(+), 38 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index a33422efa55f..4d2d0378bea7 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -1472,6 +1472,41 @@ gfc_build_null_descriptor (tree type)
}
+static tree
+set_descriptor_dimension (stmtblock_t *block, tree desc, int dim,
+ tree lbound, tree ubound, tree stride, tree *offset)
+{
+ /* Set bounds in descriptor. */
+ lbound = fold_convert (gfc_array_index_type, lbound);
+ lbound = gfc_evaluate_now (lbound, block);
+ gfc_conv_descriptor_lbound_set (block, desc,
+ gfc_rank_cst[dim], lbound);
+
+ ubound = fold_convert (gfc_array_index_type, ubound);
+ ubound = gfc_evaluate_now (ubound, block);
+ gfc_conv_descriptor_ubound_set (block, desc,
+ gfc_rank_cst[dim], ubound);
+
+ /* Set stride. */
+ stride = fold_convert (gfc_array_index_type, stride);
+ stride = gfc_evaluate_now (stride, block);
+ gfc_conv_descriptor_stride_set (block, desc,
+ gfc_rank_cst[dim], stride);
+
+ /* Update offset. */
+ tree tmp = fold_build2_loc (input_location, MULT_EXPR,
+ gfc_array_index_type, lbound, stride);
+ *offset = fold_build2_loc (input_location, MINUS_EXPR,
+ gfc_array_index_type, *offset, tmp);
+
+ /* Return stride for next dimension. */
+ tmp = gfc_conv_array_extent_dim (lbound, ubound, NULL);
+ stride = fold_build2_loc (input_location, MULT_EXPR,
+ gfc_array_index_type, stride, tmp);
+ return stride;
+}
+
+
/* Modify a descriptor such that the lbound of a given dimension is the value
specified. This also updates ubound and offset accordingly. */
@@ -1822,9 +1857,9 @@ gfc_conv_remap_descriptor (stmtblock_t *block, tree dest,
tree src,
/* Copy offset but adjust it such that it would correspond
to a lbound of zero. */
+ tree offset;
if (src_rank == -1)
-gfc_conv_descriptor_offset_set (block, dest,
- gfc_index_zero_node);
+offset = gfc_index_zero_node;
else
{
tree offs = gfc_conv_descriptor_offset_get (src);
@@ -1840,7 +1875,7 @@ gfc_conv_remap_descriptor (stmtblock_t *block, tree dest,
tree src,
offs = fold_build2_loc (input_location, PLUS_EXPR,
gfc_array_index_type, offs, tmp);
}
- gfc_conv_descriptor_offset_set (block, dest, offs);
+ offset = offs;
}
/* Set the bounds as declared for the LHS and calculate strides as
well as another offset update accordingly. */
@@ -1856,46 +1891,17 @@ gfc_conv_remap_descriptor (stmtblock_t *block, tree
dest, tree src,
/* 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_conv_expr_val (&lower_se, as.lower[dim]);
+ gfc_conv_expr_val (&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_EX
[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] Factorisation set temporary descriptor
https://gcc.gnu.org/g:e6c9f7a5d3a273f68c14ce413067b11826a33adf
commit e6c9f7a5d3a273f68c14ce413067b11826a33adf
Author: Mikael Morin
Date: Wed Feb 12 18:17:41 2025 +0100
Factorisation set temporary descriptor
Suppression code redondant initialisation descriptor temporaire
Réduction différences
Correction régression class_transformational_2
Diff:
---
gcc/fortran/trans-array.cc | 119 -
1 file changed, 74 insertions(+), 45 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 051ccafe9807..ba040d25241d 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -3294,13 +3294,14 @@ gfc_set_loop_bounds_from_array_spec
(gfc_interface_mapping * mapping,
DYNAMIC is true if the caller may want to extend the array later
using realloc. This prevents us from putting the array on the stack. */
-static void
+static tree
gfc_trans_allocate_array_storage (stmtblock_t * pre, stmtblock_t * post,
gfc_array_info * info, tree size, tree nelem,
tree initial, bool dynamic, bool dealloc)
{
tree tmp;
tree desc;
+ tree ptr = NULL_TREE;
bool onstack;
desc = info->descriptor;
@@ -3308,7 +3309,7 @@ gfc_trans_allocate_array_storage (stmtblock_t * pre,
stmtblock_t * post,
if (size == NULL_TREE || (dynamic && integer_zerop (size)))
{
/* A callee allocated array. */
- gfc_conv_descriptor_data_set (pre, desc, null_pointer_node);
+ ptr = null_pointer_node;
onstack = false;
}
else
@@ -3336,8 +3337,7 @@ gfc_trans_allocate_array_storage (stmtblock_t * pre,
stmtblock_t * post,
fold_build1_loc (input_location,
DECL_EXPR, TREE_TYPE (tmp),
tmp));
- tmp = gfc_build_addr_expr (NULL_TREE, tmp);
- gfc_conv_descriptor_data_set (pre, desc, tmp);
+ ptr = gfc_build_addr_expr (NULL_TREE, tmp);
}
else
{
@@ -3345,7 +3345,7 @@ gfc_trans_allocate_array_storage (stmtblock_t * pre,
stmtblock_t * post,
if (initial == NULL_TREE)
{
tmp = gfc_call_malloc (pre, NULL, size);
- tmp = gfc_evaluate_now (tmp, pre);
+ ptr = gfc_evaluate_now (tmp, pre);
}
else
{
@@ -3388,18 +3388,12 @@ gfc_trans_allocate_array_storage (stmtblock_t * pre,
stmtblock_t * post,
build_empty_stmt (input_location));
gfc_add_expr_to_block (pre, tmp);
- tmp = fold_convert (pvoid_type_node, packed);
+ ptr = fold_convert (pvoid_type_node, packed);
}
-
- gfc_conv_descriptor_data_set (pre, desc, tmp);
}
}
info->data = gfc_conv_descriptor_data_get (desc);
- /* The offset is zero because we create temporaries with a zero
- lower bound. */
- gfc_conv_descriptor_offset_set (pre, desc, gfc_index_zero_node);
-
if (dealloc && !onstack)
{
/* Free the temporary. */
@@ -3407,6 +3401,8 @@ gfc_trans_allocate_array_storage (stmtblock_t * pre,
stmtblock_t * post,
tmp = gfc_call_free (tmp);
gfc_add_expr_to_block (post, tmp);
}
+
+ return ptr;
}
@@ -3618,6 +3614,61 @@ get_class_info_from_ss (stmtblock_t * pre, gfc_ss *ss,
tree *eltype,
}
+static void
+set_temporary_descriptor (stmtblock_t *block, tree desc, tree class_src,
+ tree elemsize, tree data_ptr,
+ tree ubound[GFC_MAX_DIMENSIONS],
+ tree stride[GFC_MAX_DIMENSIONS], int rank,
+ bool callee_allocated, bool rank_changer)
+{
+ int n;
+
+ if (!class_src)
+{
+ /* Fill in the array dtype. */
+ gfc_conv_descriptor_dtype_set (block, desc,
+gfc_get_dtype (TREE_TYPE (desc)));
+}
+ else if (rank_changer)
+{
+ /* For classes, we copy the whole original class descriptor to the
+ temporary one, so we don't need to set the individual dtype fields.
+Except for the case of rank altering intrinsics for which we
+generate descriptors of different rank. */
+
+ /* Take the dtype from the class expression. */
+ tree src_data = gfc_class_data_get (class_src);
+ tree dtype = gfc_conv_descriptor_dtype_get (src_data);
+ gfc_conv_descriptor_dtype_set (block, desc, dtype);
+
+ /* These transformational functions change the rank. */
+ gfc_conv_descriptor_rank_set (block, desc, rank);
+}
+
+ if (!callee_allocated)
+{
+ for (n = 0; n < rank; n++)
+ {
+ /* Store the stride and bound components in the descriptor. */
+ gfc_conv_descriptor_stride_set (block, desc, gfc_rank_cst[n],
+ stride[n]);
+
+
[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_dimension
https://gcc.gnu.org/g:ddb31d5d6926f57296dc9514c6cd17227eaba66f
commit ddb31d5d6926f57296dc9514c6cd17227eaba66f
Author: Mikael Morin
Date: Thu Feb 13 20:26:47 2025 +0100
Factorisation set_descriptor_dimension
Correction typo
Diff:
---
gcc/fortran/trans-array.cc | 12 +---
1 file changed, 5 insertions(+), 7 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index ba040d25241d..3bfe41c64013 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -1904,6 +1904,9 @@ set_bounds_update_offset (stmtblock_t *block, tree desc,
int dim,
gfc_conv_descriptor_stride_set (block, desc,
gfc_rank_cst[dim], stride);
+ if (!offset && !next_stride)
+return;
+
/* Update offset. */
tree tmp = fold_build2_loc (input_location, MULT_EXPR,
gfc_array_index_type, lbound_diff, stride);
@@ -3650,13 +3653,8 @@ set_temporary_descriptor (stmtblock_t *block, tree desc,
tree class_src,
for (n = 0; n < rank; n++)
{
/* Store the stride and bound components in the descriptor. */
- gfc_conv_descriptor_stride_set (block, desc, gfc_rank_cst[n],
- stride[n]);
-
- gfc_conv_descriptor_lbound_set (block, desc, gfc_rank_cst[n],
- gfc_index_zero_node);
-
- gfc_conv_descriptor_ubound_set (block, desc, gfc_rank_cst[n],
ubound[n]);
+ set_descriptor_dimension (block, desc, n, gfc_index_zero_node,
ubound[n],
+ stride[n], nullptr, nullptr);
}
}
[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] Factorisation shift_descriptor
https://gcc.gnu.org/g:9a83288a7a4b4eed3b7c32271842013f9748d143
commit 9a83288a7a4b4eed3b7c32271842013f9748d143
Author: Mikael Morin
Date: Thu Feb 13 21:03:54 2025 +0100
Factorisation shift_descriptor
Diff:
---
gcc/fortran/trans-expr.cc | 76 ---
1 file changed, 39 insertions(+), 37 deletions(-)
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 6ed87fc63a9b..016ac2ee944c 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -5207,6 +5207,43 @@ gfc_apply_interface_mapping (gfc_interface_mapping *
mapping,
}
+static void
+shift_descriptor (stmtblock_t *block, tree desc, int rank,
+ tree lbound[GFC_MAX_DIMENSIONS],
+ tree ubound[GFC_MAX_DIMENSIONS])
+
+{
+ tree size = gfc_index_one_node;
+ tree offset = gfc_index_zero_node;
+ for (int n = 0; n < rank; n++)
+{
+ tree tmp = gfc_conv_descriptor_ubound_get (desc, gfc_rank_cst[n]);
+ tmp = fold_build2_loc (input_location, PLUS_EXPR,
+gfc_array_index_type, tmp,
+gfc_index_one_node);
+ gfc_conv_descriptor_ubound_set (block,
+ desc,
+ gfc_rank_cst[n],
+ tmp);
+ gfc_conv_descriptor_lbound_set (block,
+ desc,
+ gfc_rank_cst[n],
+ gfc_index_one_node);
+ size = gfc_evaluate_now (size, block);
+ offset = fold_build2_loc (input_location, MINUS_EXPR,
+ gfc_array_index_type,
+ offset, size);
+ offset = gfc_evaluate_now (offset, block);
+ tmp = gfc_conv_array_extent_dim (lbound[n], ubound[n], nullptr);
+ size = fold_build2_loc (input_location, MULT_EXPR,
+ gfc_array_index_type, size, tmp);
+}
+
+ gfc_conv_descriptor_offset_set (block, desc,
+ offset);
+}
+
+
/* Returns a reference to a temporary array into which a component of
an actual argument derived type array is copied and then returned
after the function call. */
@@ -5227,7 +5264,6 @@ gfc_conv_subref_array_arg (gfc_se *se, gfc_expr * expr,
int g77,
tree tmp_index;
tree tmp;
tree base_type;
- tree size;
stmtblock_t body;
int n;
int dimen;
@@ -5471,42 +5507,8 @@ class_array_fcn:
/* Determine the offset for pointer formal arguments and set the
lbounds to one. */
if (formal_ptr)
-{
- size = gfc_index_one_node;
- offset = gfc_index_zero_node;
- for (n = 0; n < dimen; n++)
- {
- tmp = gfc_conv_descriptor_ubound_get (parmse->expr,
- gfc_rank_cst[n]);
- tmp = fold_build2_loc (input_location, PLUS_EXPR,
-gfc_array_index_type, tmp,
-gfc_index_one_node);
- gfc_conv_descriptor_ubound_set (&parmse->pre,
- parmse->expr,
- gfc_rank_cst[n],
- tmp);
- gfc_conv_descriptor_lbound_set (&parmse->pre,
- parmse->expr,
- gfc_rank_cst[n],
- gfc_index_one_node);
- size = gfc_evaluate_now (size, &parmse->pre);
- offset = fold_build2_loc (input_location, MINUS_EXPR,
- gfc_array_index_type,
- offset, size);
- offset = gfc_evaluate_now (offset, &parmse->pre);
- tmp = fold_build2_loc (input_location, MINUS_EXPR,
-gfc_array_index_type,
-rse.loop->to[n], rse.loop->from[n]);
- tmp = fold_build2_loc (input_location, PLUS_EXPR,
-gfc_array_index_type,
-tmp, gfc_index_one_node);
- size = fold_build2_loc (input_location, MULT_EXPR,
- gfc_array_index_type, size, tmp);
- }
-
- gfc_conv_descriptor_offset_set (&parmse->pre, parmse->expr,
- offset);
-}
+shift_descriptor (&parmse->pre, parmse->expr, dimen,
+ rse.loop->from, rse.loop->to);
/* We want either the address for the data or the address of the descriptor,
depending on the mode of passing array arguments. */
[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] Factorisation set_descriptor_from_scalar dans gfc_conv_scalar_to_descriptor
https://gcc.gnu.org/g:468055f1d8a69b5b86fa7d661811bcd6263dbb51
commit 468055f1d8a69b5b86fa7d661811bcd6263dbb51
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
Suppression code redondant
Diff:
---
gcc/fortran/trans-expr.cc | 59 ---
1 file changed, 30 insertions(+), 29 deletions(-)
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 091e1417faed..18d54d2a1f93 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -174,46 +174,53 @@ 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);
+ 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 = 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,
+ 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 +231,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 +1083,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 +1459,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, parmse->expr,
+ gfc_expr_attr (e), true, NULL_TREE);
else
gfc_class_array_data_assign (&block, ctree, parmse->expr, false);
[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] match: Unwrap non-lvalue as unary or binary operand
https://gcc.gnu.org/g:ab0d39c3b07ee84a26feed2a5a5fac92233073aa
commit ab0d39c3b07ee84a26feed2a5a5fac92233073aa
Author: Mikael Morin
Date: Thu Jul 4 15:24:36 2024 +0200
match: Unwrap non-lvalue as unary or binary operand
This avoids most of the testsuite dump pattern updates with a patch
generating more NON_LVALUE_EXPR trees that I plan to post later.
Regression tested on x86_64-linux. OK for master?
-- 8< --
gcc/ChangeLog:
* match.pd (`op (non_lvalue X) Y`, `op X (non_lvalue Y)`,
`op (non_lvalue X)`): New simplifications, unwrap NON_LVALUE_EXPR
trees when they are used as operand of a unary or binary operator.
gcc/testsuite/ChangeLog:
* gfortran.dg/non_lvalue_2.f90: New test.
Diff:
---
gcc/match.pd | 12
gcc/testsuite/gfortran.dg/non_lvalue_2.f90 | 44 ++
2 files changed, 56 insertions(+)
diff --git a/gcc/match.pd b/gcc/match.pd
index 5e6bb8945e8b..85b4e8013783 100644
--- a/gcc/match.pd
+++ b/gcc/match.pd
@@ -281,6 +281,18 @@ DEFINE_INT_AND_FLOAT_ROUND_FN (RINT)
(outer_op @0 @2)
@3))
+/* Remove superfluous NON_LVALUE_EXPR in unary operators. */
+(for op (UNCOND_UNARY)
+ (simplify (op (non_lvalue @0))
+ (op @0)))
+
+/* Remove superfluous NON_LVALUE_EXPR in binary operators. */
+(for op (UNCOND_BINARY tcc_comparison)
+ (simplify (op (non_lvalue @0) @1)
+ (op @0 @1))
+ (simplify (op @0 (non_lvalue @1))
+ (op @0 @1)))
+
/* Simplify x - x.
This is unsafe for certain floats even in non-IEEE formats.
In IEEE, it is unsafe because it does wrong for NaNs.
diff --git a/gcc/testsuite/gfortran.dg/non_lvalue_2.f90
b/gcc/testsuite/gfortran.dg/non_lvalue_2.f90
new file mode 100644
index ..8c3197eab1f0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/non_lvalue_2.f90
@@ -0,0 +1,44 @@
+! { dg-do compile }
+! { dg-additional-options "-fdump-tree-original" }
+!
+! Check the removal of NON_LVALUE_EXPR if they are used in a non-lvalue context
+
+! The NON_LVALUE_EXPR is dropped if it's part (left operand) of a bigger
expression
+function f1 (f1_arg1, f1_arg2)
+ integer, value :: f1_arg1, f1_arg2
+ integer :: f1
+ f1 = (f1_arg1 + 0) + f1_arg2
+end function
+! { dg-final { scan-tree-dump "__result_f1 = f1_arg1 \\+ f1_arg2;" "original"
} }
+
+! The NON_LVALUE_EXPR is dropped if it's part (right operand) of a bigger
expression
+function f2 (f2_arg1, f2_arg2)
+ integer, value :: f2_arg1, f2_arg2
+ integer :: f2
+ f2 = f2_arg1 + (f2_arg2 + 0)
+end function
+! { dg-final { scan-tree-dump "__result_f2 = f2_arg1 \\+ f2_arg2;" "original"
} }
+
+! The NON_LVALUE_EXPR is dropped if it's part (left operand) of a binary
logical operator
+function f3 (f3_arg1)
+ integer, value :: f3_arg1
+ logical :: f3
+ f3 = (f3_arg1 + 0) > 0
+end function
+! { dg-final { scan-tree-dump "__result_f3 = f3_arg1 > 0;" "original" } }
+
+! The NON_LVALUE_EXPR is dropped if it's part (right operand) of a binary
logical operator
+function f4 (f4_arg1, f4_arg2)
+ integer, value :: f4_arg1, f4_arg2
+ logical :: f4
+ f4 = f4_arg1 > (f4_arg2 + 0)
+end function
+! { dg-final { scan-tree-dump "__result_f4 = f4_arg1 > f4_arg2;" "original" } }
+
+! The NON_LVALUE_EXPR is dropped if it's part of a unary operator
+function f5 (f5_arg1)
+ integer, value :: f5_arg1
+ integer :: f5
+ f5 = -(not(not(f5_arg1)))
+end function
+! { dg-final { scan-tree-dump "__result_f5 = -f5_arg1;" "original" } }
[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] match: Simplify double not and double negate to a non_lvalue
https://gcc.gnu.org/g:6c677650e4960d95c4e5f6495249108bcfaf4107
commit 6c677650e4960d95c4e5f6495249108bcfaf4107
Author: Mikael Morin
Date: Thu Jul 4 12:59:34 2024 +0200
match: Simplify double not and double negate to a non_lvalue
I noticed while testing the second patch that none of the NON_LVALUE_EXPR
trees I expected were generated when simplifying unary operators, whereas
they were generated with binary operators.
Regression tested on x86_64-linux. OK for master?
-- 8< --
gcc/ChangeLog:
* match.pd (`-(-X)`, `~(~X)`): Add a NON_LVALUE_EXPR wrapper to the
simplification of doubled unary operators NEGATE_EXPR and
BIT_NOT_EXPR.
gcc/testsuite/ChangeLog:
* gfortran.dg/non_lvalue_1.f90: New test.
Diff:
---
gcc/match.pd | 4 ++--
gcc/testsuite/gfortran.dg/non_lvalue_1.f90 | 21 +
2 files changed, 23 insertions(+), 2 deletions(-)
diff --git a/gcc/match.pd b/gcc/match.pd
index 171930874988..5e6bb8945e8b 100644
--- a/gcc/match.pd
+++ b/gcc/match.pd
@@ -2318,7 +2318,7 @@ DEFINE_INT_AND_FLOAT_ROUND_FN (RINT)
/* ~~x -> x */
(simplify
(bit_not (bit_not @0))
- @0)
+ (non_lvalue @0))
/* zero_one_valued_p will match when a value is known to be either
0 or 1 including constants 0 or 1.
@@ -3930,7 +3930,7 @@ DEFINE_INT_AND_FLOAT_ROUND_FN (RINT)
(negate (nop_convert? (negate @1)))
(if (!TYPE_OVERFLOW_SANITIZED (type)
&& !TYPE_OVERFLOW_SANITIZED (TREE_TYPE (@1)))
- (view_convert @1)))
+ (non_lvalue (view_convert @1
/* We can't reassociate floating-point unless -fassociative-math
or fixed-point plus or minus because of saturation to +-Inf. */
diff --git a/gcc/testsuite/gfortran.dg/non_lvalue_1.f90
b/gcc/testsuite/gfortran.dg/non_lvalue_1.f90
new file mode 100644
index ..ac52b2720945
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/non_lvalue_1.f90
@@ -0,0 +1,21 @@
+! { dg-do compile }
+! { dg-additional-options "-fdump-tree-original" }
+!
+! Check the generation of NON_LVALUE_EXPR trees in cases where a unary
operator expression
+! simplifies to a data reference.
+
+! A NON_LVALUE_EXPR is generated for a double negation that simplifies to a
data reference. */
+function f1 (f1_arg1)
+ integer, value :: f1_arg1
+ integer :: f1
+ f1 = -(-f1_arg1)
+end function
+! { dg-final { scan-tree-dump "__result_f1 = NON_LVALUE_EXPR ;"
"original" } }
+
+! A NON_LVALUE_EXPR is generated for a double complement that simplifies to a
data reference. */
+function f2 (f2_arg1)
+ integer, value :: f2_arg1
+ integer :: f2
+ f2 = not(not(f2_arg1))
+end function
+! { dg-final { scan-tree-dump "__result_f2 = NON_LVALUE_EXPR ;"
"original" } }
[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] Correction non_lvalue PR97046.f90
https://gcc.gnu.org/g:a6c99173bb640f2af17d64ed1cd4ee00ae2146b1 commit a6c99173bb640f2af17d64ed1cd4ee00ae2146b1 Author: Mikael Morin Date: Wed Feb 12 10:07:40 2025 +0100 Correction non_lvalue PR97046.f90 Diff: --- gcc/fortran/trans-array.cc | 42 +++--- 1 file changed, 27 insertions(+), 15 deletions(-) diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc index 7072927a30be..19c6768cc66e 100644 --- a/gcc/fortran/trans-array.cc +++ b/gcc/fortran/trans-array.cc @@ -2556,24 +2556,31 @@ gfc_set_gfc_from_cfi (stmtblock_t *unconditional_block, tree tmp2 = fold_build3_loc (input_location, COND_EXPR, void_type_node, cond, gfc_finish_block (&set_void), gfc_finish_block (&set_unknown)); + /* 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)); + stmtblock_t set_derived; + gfc_init_block (&set_derived); + tree derived_value = build_int_cst (TREE_TYPE (type), BT_DERIVED); + gfc_conv_descriptor_type_set (&set_derived, gfc, derived_value); tmp2 = fold_build3_loc (input_location, COND_EXPR, void_type_node, cond, - tmp, tmp2); + gfc_finish_block (&set_derived), 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)); + stmtblock_t set_character; + gfc_init_block (&set_character); + tree character_value = build_int_cst (TREE_TYPE (type), BT_CHARACTER); + gfc_conv_descriptor_type_set (&set_character, gfc, character_value); tmp2 = fold_build3_loc (input_location, COND_EXPR, void_type_node, cond, - tmp, tmp2); + gfc_finish_block (&set_character), 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 @@ -2583,18 +2590,22 @@ gfc_set_gfc_from_cfi (stmtblock_t *unconditional_block, cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, tmp, build_int_cst (TREE_TYPE (tmp), CFI_type_ucs4_char)); - tmp = fold_build2_loc (input_location, MODIFY_EXPR, void_type_node, type, -build_int_cst (TREE_TYPE (type), BT_CHARACTER)); + gfc_init_block (&set_character); + gfc_conv_descriptor_type_set (&set_character, gfc, character_value); tmp2 = fold_build3_loc (input_location, COND_EXPR, void_type_node, cond, - tmp, tmp2); + gfc_finish_block (&set_character), tmp2); + /* if (CFI_type_Complex) BT_COMPLEX + cfi->elem_len/2 else < tmp2 > */ cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, ctype, build_int_cst (TREE_TYPE (ctype), CFI_type_Complex)); - tmp = fold_build2_loc (input_location, MODIFY_EXPR, void_type_node, type, -build_int_cst (TREE_TYPE (type), BT_COMPLEX)); + stmtblock_t set_complex; + gfc_init_block (&set_complex); + tree complex_value = build_int_cst (TREE_TYPE (type), BT_COMPLEX); + gfc_conv_descriptor_type_set (&set_complex, gfc, complex_value); tmp2 = fold_build3_loc (input_location, COND_EXPR, void_type_node, cond, - tmp, tmp2); + gfc_finish_block (&set_complex), tmp2); + /* if (CFI_type_Integer || CFI_type_Logical || CFI_type_Real) ctype else*/ cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, ctype, @@ -2610,10 +2621,11 @@ gfc_set_gfc_from_cfi (stmtblock_t *unconditional_block, CFI_type_Real)); cond = fold_build2_loc (input_location, TRUTH_OR_EXPR, boolean_type_node, cond, tmp); - tmp = fold_build2_loc (input_location, MODIFY_EXPR, void_type_node, -
[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] Correction erreurs non-lvalue lhs pr113363.f90
https://gcc.gnu.org/g:a6b20dd1bd5b8669a2a496045c6f1970df5c7472
commit a6b20dd1bd5b8669a2a496045c6f1970df5c7472
Author: Mikael Morin
Date: Wed Feb 12 10:47:31 2025 +0100
Correction erreurs non-lvalue lhs pr113363.f90
Diff:
---
gcc/fortran/trans-decl.cc | 21 +
gcc/fortran/trans.cc | 4 ++--
2 files changed, 19 insertions(+), 6 deletions(-)
diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc
index 450a30871577..b3ebc056e4cf 100644
--- a/gcc/fortran/trans-decl.cc
+++ b/gcc/fortran/trans-decl.cc
@@ -5113,10 +5113,23 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym,
gfc_wrapped_block * block)
if (!sym->attr.dummy || sym->attr.intent == INTENT_OUT)
{
/* Nullify when entering the scope. */
- tmp = fold_build2_loc (input_location, MODIFY_EXPR,
-TREE_TYPE (se.expr), se.expr,
-fold_convert (TREE_TYPE (se.expr),
- null_pointer_node));
+ if (sym->ts.type == BT_CLASS
+ && (CLASS_DATA (sym)->attr.dimension
+ || CLASS_DATA (sym)->attr.codimension))
+ {
+ stmtblock_t nullify;
+ gfc_init_block (&nullify);
+ gfc_conv_descriptor_data_set (&nullify, descriptor,
+ null_pointer_node);
+ tmp = gfc_finish_block (&nullify);
+ }
+ else
+ {
+ tmp = fold_build2_loc (input_location, MODIFY_EXPR,
+TREE_TYPE (se.expr), se.expr,
+fold_convert (TREE_TYPE
(se.expr),
+
null_pointer_node));
+ }
if (sym->attr.optional)
{
tree present = gfc_conv_expr_present (sym);
diff --git a/gcc/fortran/trans.cc b/gcc/fortran/trans.cc
index e7cccb6b0bca..f0ad42c92ead 100644
--- a/gcc/fortran/trans.cc
+++ b/gcc/fortran/trans.cc
@@ -1737,7 +1737,7 @@ gfc_finalize_tree_expr (gfc_se *se, gfc_symbol *derived,
gfc_call_free (data_ptr),
build_empty_stmt (input_location));
gfc_add_expr_to_block (&se->loop->post, tmp);
- gfc_add_modify (&se->loop->post, data_ptr, data_null);
+ gfc_conv_descriptor_data_set (&se->loop->post, desc, data_null);
}
else
{
@@ -1751,7 +1751,7 @@ gfc_finalize_tree_expr (gfc_se *se, gfc_symbol *derived,
gfc_call_free (data_ptr),
build_empty_stmt (input_location));
gfc_add_expr_to_block (&se->finalblock, tmp);
- gfc_add_modify (&se->finalblock, data_ptr, data_null);
+ gfc_conv_descriptor_data_set (&se->finalblock, desc, data_null);
}
}
}
[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] Factorisation initialisation dimension descripteur
https://gcc.gnu.org/g:ded0b8188e80164e73fef5b8f3051ec2e7f36eb1
commit ded0b8188e80164e73fef5b8f3051ec2e7f36eb1
Author: Mikael Morin
Date: Sat Feb 8 21:37:49 2025 +0100
Factorisation initialisation dimension descripteur
Correction régression realloc_on_assign_12.f90
Diff:
---
gcc/fortran/trans-array.cc | 87 +-
1 file changed, 48 insertions(+), 39 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 4d2d0378bea7..e60204ae3ee2 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -1472,38 +1472,56 @@ gfc_build_null_descriptor (tree type)
}
-static tree
-set_descriptor_dimension (stmtblock_t *block, tree desc, int dim,
- tree lbound, tree ubound, tree stride, tree *offset)
+static void
+set_bounds_update_offset (stmtblock_t *block, tree desc, int dim,
+ tree lbound, tree ubound, tree stride, tree
lbound_diff,
+ tree *offset, tree *next_stride, bool
stride_unchanged)
{
- /* Set bounds in descriptor. */
+ /* Stabilize values in case the expressions depend on the existing bounds.
*/
lbound = fold_convert (gfc_array_index_type, lbound);
lbound = gfc_evaluate_now (lbound, block);
- gfc_conv_descriptor_lbound_set (block, desc,
- gfc_rank_cst[dim], lbound);
ubound = fold_convert (gfc_array_index_type, ubound);
ubound = gfc_evaluate_now (ubound, block);
- gfc_conv_descriptor_ubound_set (block, desc,
- gfc_rank_cst[dim], ubound);
- /* Set stride. */
stride = fold_convert (gfc_array_index_type, stride);
stride = gfc_evaluate_now (stride, block);
- gfc_conv_descriptor_stride_set (block, desc,
- gfc_rank_cst[dim], stride);
+
+ lbound_diff = fold_convert (gfc_array_index_type, lbound_diff);
+ lbound_diff = gfc_evaluate_now (lbound_diff, block);
+
+ gfc_conv_descriptor_lbound_set (block, desc,
+ gfc_rank_cst[dim], lbound);
+ gfc_conv_descriptor_ubound_set (block, desc,
+ gfc_rank_cst[dim], ubound);
+ if (!stride_unchanged)
+gfc_conv_descriptor_stride_set (block, desc,
+ gfc_rank_cst[dim], stride);
/* Update offset. */
tree tmp = fold_build2_loc (input_location, MULT_EXPR,
- gfc_array_index_type, lbound, stride);
- *offset = fold_build2_loc (input_location, MINUS_EXPR,
- gfc_array_index_type, *offset, tmp);
+ gfc_array_index_type, lbound_diff, stride);
+ tmp = fold_build2_loc (input_location, MINUS_EXPR,
+gfc_array_index_type, *offset, tmp);
+ *offset = gfc_evaluate_now (tmp, block);
+
+ if (!next_stride)
+return;
- /* Return stride for next dimension. */
+ /* Set stride for next dimension. */
tmp = gfc_conv_array_extent_dim (lbound, ubound, NULL);
- stride = fold_build2_loc (input_location, MULT_EXPR,
- gfc_array_index_type, stride, tmp);
- return stride;
+ *next_stride = fold_build2_loc (input_location, MULT_EXPR,
+ gfc_array_index_type, stride, tmp);
+}
+
+
+static void
+set_descriptor_dimension (stmtblock_t *block, tree desc, int dim,
+ tree lbound, tree ubound, tree stride, tree *offset,
+ tree *next_stride)
+{
+ set_bounds_update_offset (block, desc, dim, lbound, ubound, stride, lbound,
+ offset, next_stride, false);
}
@@ -1512,7 +1530,7 @@ set_descriptor_dimension (stmtblock_t *block, tree desc,
int dim,
static void
conv_shift_descriptor_lbound (stmtblock_t* block, tree from_desc, tree
to_desc, int dim,
- tree new_lbound, tree offset, bool zero_based)
+ tree new_lbound, tree *offset, bool zero_based)
{
new_lbound = fold_convert (gfc_array_index_type, new_lbound);
new_lbound = gfc_evaluate_now (new_lbound, block);
@@ -1536,18 +1554,9 @@ conv_shift_descriptor_lbound (stmtblock_t* block, tree
from_desc, tree to_desc,
updating the lbound, as they depend on the lbound expression! */
tree tmp1 = 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], tmp1);
- /* Set lbound to the value we want. */
- gfc_conv_descriptor_lbound_set (block, to_desc, gfc_rank_cst[dim],
new_lbound);
- tree offs_diff = fold_build2_loc (input_location, MULT_EXPR,
gfc_array_index_type,
- diff, stride);
- tree tmp2 = fold_build2_loc (input_location, MINUS_EXPR,
gfc_array_index_type,
- offset, offs_diff);
- gfc_add_modify (block, offset, tmp2);
-
- if (from_desc != to_desc)
-
[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] Renseignement token par gfc_set_descriptor_from_scalar.
https://gcc.gnu.org/g:d2722a02e8d2f2eada5abd697282e3a51327c285
commit d2722a02e8d2f2eada5abd697282e3a51327c285
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(refs/users/mikael/heads/refactor_descriptor_v01)] Interdiction non-lvalue as lhs
https://gcc.gnu.org/g:749c1436aba9cf3b6876fa8f31aac82af8329c64
commit 749c1436aba9cf3b6876fa8f31aac82af8329c64
Author: Mikael Morin
Date: Tue Feb 11 21:34:11 2025 +0100
Interdiction non-lvalue as lhs
git commit correction erreur gimplify
Diff:
---
gcc/gimplify.cc | 6 ++
1 file changed, 6 insertions(+)
diff --git a/gcc/gimplify.cc b/gcc/gimplify.cc
index 58a9d2a748d6..73f558eb634e 100644
--- a/gcc/gimplify.cc
+++ b/gcc/gimplify.cc
@@ -6838,6 +6838,12 @@ gimplify_modify_expr (tree *expr_p, gimple_seq *pre_p,
gimple_seq *post_p,
gcc_assert (TREE_CODE (*expr_p) == MODIFY_EXPR
|| TREE_CODE (*expr_p) == INIT_EXPR);
+ if (TREE_CODE (*to_p) == NON_LVALUE_EXPR)
+{
+ error ("non-lvalue used as lhs in %qD", *expr_p);
+ return GS_ERROR;
+}
+
/* Trying to simplify a clobber using normal logic doesn't work,
so handle it here. */
if (TREE_CLOBBER_P (*from_p))
[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] réduction différences dump assumed_rank_12.f90
https://gcc.gnu.org/g:79734111aa08107a2cafd5bdb5744fa5cef5aa92
commit 79734111aa08107a2cafd5bdb5744fa5cef5aa92
Author: Mikael Morin
Date: Wed Feb 5 11:45:00 2025 +0100
réduction différences 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)] Update dump match count
https://gcc.gnu.org/g:123a4927b085ed0044f4ef885726f4ab3f2aaa84
commit 123a4927b085ed0044f4ef885726f4ab3f2aaa84
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(refs/users/mikael/heads/refactor_descriptor_v01)] Séparation motifs dump assumed_rank_12.f90
https://gcc.gnu.org/g:d57bd41920599b47a05068e6a78fbc44d786e441
commit d57bd41920599b47a05068e6a78fbc44d786e441
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 fonction
https://gcc.gnu.org/g:a7d30957412cc9d49cbe8c775f3d9ad1f46bfad8
commit a7d30957412cc9d49cbe8c775f3d9ad1f46bfad8
Author: Mikael Morin
Date: Fri Feb 14 09:34:02 2025 +0100
Déplacement fonction
Diff:
---
gcc/fortran/trans-array.cc | 53 ++
gcc/fortran/trans-array.h | 1 +
gcc/fortran/trans-expr.cc | 41 ++-
3 files changed, 47 insertions(+), 48 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 3bfe41c64013..8981a420c97a 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -2225,6 +2225,44 @@ gfc_conv_shift_descriptor_subarray (stmtblock_t *block,
tree desc,
}
+void
+gfc_conv_shift_descriptor (stmtblock_t *block, tree desc, int rank,
+ tree lbound[GFC_MAX_DIMENSIONS],
+ tree ubound[GFC_MAX_DIMENSIONS])
+{
+ tree size = gfc_index_one_node;
+ tree offset = gfc_index_zero_node;
+ for (int n = 0; n < rank; n++)
+{
+ tree tmp = gfc_conv_descriptor_ubound_get (desc, gfc_rank_cst[n]);
+ tmp = fold_build2_loc (input_location, PLUS_EXPR,
+gfc_array_index_type, tmp,
+gfc_index_one_node);
+ gfc_conv_descriptor_ubound_set (block,
+ desc,
+ gfc_rank_cst[n],
+ tmp);
+ gfc_conv_descriptor_lbound_set (block,
+ desc,
+ gfc_rank_cst[n],
+ gfc_index_one_node);
+ size = gfc_evaluate_now (size, block);
+ offset = fold_build2_loc (input_location, MINUS_EXPR,
+ gfc_array_index_type,
+ offset, size);
+ offset = gfc_evaluate_now (offset, block);
+ tmp = gfc_conv_array_extent_dim (lbound[n], ubound[n], nullptr);
+ size = fold_build2_loc (input_location, MULT_EXPR,
+ gfc_array_index_type, size, tmp);
+}
+
+ gfc_conv_descriptor_offset_set (block, desc,
+ offset);
+}
+
+
+
+
int
gfc_descriptor_rank (tree descriptor)
{
@@ -8392,15 +8430,12 @@ gfc_array_init_size (tree descriptor, int rank, int
corank, tree * poffset,
start at zero, but when allocating it, the standard expects
the array to start at one. Therefore fix the upper bound to be
(desc.ubound - desc.lbound) + 1. */
- tmp = fold_build2_loc (input_location, MINUS_EXPR,
-gfc_array_index_type,
-gfc_conv_descriptor_ubound_get (
- expr3_desc, gfc_rank_cst[n]),
-gfc_conv_descriptor_lbound_get (
- expr3_desc, gfc_rank_cst[n]));
- tmp = fold_build2_loc (input_location, PLUS_EXPR,
-gfc_array_index_type, tmp,
-gfc_index_one_node);
+ tmp = gfc_conv_array_extent_dim (
+ gfc_conv_descriptor_lbound_get (expr3_desc,
+ gfc_rank_cst[n]),
+ gfc_conv_descriptor_ubound_get (expr3_desc,
+ gfc_rank_cst[n]),
+ nullptr);
se.expr = gfc_evaluate_now (tmp, pblock);
}
else
diff --git a/gcc/fortran/trans-array.h b/gcc/fortran/trans-array.h
index 836a177da014..f37f09c21cff 100644
--- a/gcc/fortran/trans-array.h
+++ b/gcc/fortran/trans-array.h
@@ -237,6 +237,7 @@ 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);
void gfc_conv_shift_descriptor_subarray (stmtblock_t*, tree, gfc_expr *,
gfc_expr *);
+void gfc_conv_shift_descriptor (stmtblock_t *, tree, int, tree *, 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 016ac2ee944c..13cb7f9fd8fa 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -5207,43 +5207,6 @@ gfc_apply_interface_mapping (gfc_interface_mapping *
mapping,
}
-static void
-shift_descriptor (stmtblock_t *block, tree desc, int rank,
- tree lbound[GFC_MAX_DIMENSIONS],
- tree ubound[GFC_MAX_DIMENSIONS])
-
-{
- tree size = gfc_index_one_node;
- tree offset = gfc_index_zero_node;
- for (int n = 0; n < rank; n++)
-{
- tree tmp = gfc_conv_descriptor_ubound_get (desc, gfc_rank_cst[n]);
- tmp = fold_build2_loc (input_location, PLUS_EXPR,
-gf
[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] Ajout surcharge gfc_conv_descriptor_type_set
https://gcc.gnu.org/g:35c975b3a6ee65be51b96848764a90105aa59f81
commit 35c975b3a6ee65be51b96848764a90105aa59f81
Author: Mikael Morin
Date: Wed Feb 12 10:22:42 2025 +0100
Ajout surcharge gfc_conv_descriptor_type_set
Diff:
---
gcc/fortran/trans-array.cc | 41 +
1 file changed, 29 insertions(+), 12 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 19c6768cc66e..051ccafe9807 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -261,6 +261,15 @@ get_field (tree desc, unsigned field_idx)
return field;
}
+tree
+get_dtype_subfield (tree desc, unsigned subfield)
+{
+ tree dtype = get_field (desc, DTYPE_FIELD);
+ tree field = gfc_advance_chain (TYPE_FIELDS (TREE_TYPE (dtype)), subfield);
+ gcc_assert (field != NULL_TREE);
+ return field;
+}
+
tree
get_component (tree desc, unsigned field_idx)
{
@@ -518,6 +527,14 @@ conv_type_set (stmtblock_t *block, tree desc, tree value)
fold_convert_loc (loc, TREE_TYPE (t), value));
}
+void
+conv_type_set (stmtblock_t *block, tree desc, int value)
+{
+ tree field = get_dtype_subfield (desc, GFC_DTYPE_TYPE);
+ tree val = build_int_cst (TREE_TYPE (field), value);
+ conv_type_set (block, desc, val);
+}
+
tree
get_dimensions (tree desc)
{
@@ -870,6 +887,12 @@ gfc_conv_descriptor_type_set (stmtblock_t *block, tree
desc, tree value)
gfc_descriptor::conv_type_set (block, desc, value);
}
+void
+gfc_conv_descriptor_type_set (stmtblock_t *block, tree desc, int value)
+{
+ gfc_descriptor::conv_type_set (block, desc, value);
+}
+
tree
gfc_conv_descriptor_token_get (tree desc)
{
@@ -2536,7 +2559,6 @@ gfc_set_gfc_from_cfi (stmtblock_t *unconditional_block,
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_get (gfc);
/* if (CFI_type_cptr) BT_VOID else BT_UNKNOWN */
/* Note: BT_VOID is could also be CFI_type_funcptr, but assume c_ptr. */
@@ -2545,13 +2567,11 @@ gfc_set_gfc_from_cfi (stmtblock_t *unconditional_block,
stmtblock_t set_void;
gfc_init_block (&set_void);
- tree void_value = build_int_cst (TREE_TYPE (type), BT_VOID);
- gfc_conv_descriptor_type_set (&set_void, gfc, void_value);
+ gfc_conv_descriptor_type_set (&set_void, gfc, BT_VOID);
stmtblock_t set_unknown;
gfc_init_block (&set_unknown);
- tree unknown_value = build_int_cst (TREE_TYPE (type), BT_UNKNOWN);
- gfc_conv_descriptor_type_set (&set_unknown, gfc, unknown_value);
+ gfc_conv_descriptor_type_set (&set_unknown, gfc, BT_UNKNOWN);
tree tmp2 = fold_build3_loc (input_location, COND_EXPR, void_type_node,
cond,
gfc_finish_block (&set_void),
@@ -2563,8 +2583,7 @@ gfc_set_gfc_from_cfi (stmtblock_t *unconditional_block,
CFI_type_struct));
stmtblock_t set_derived;
gfc_init_block (&set_derived);
- tree derived_value = build_int_cst (TREE_TYPE (type), BT_DERIVED);
- gfc_conv_descriptor_type_set (&set_derived, gfc, derived_value);
+ gfc_conv_descriptor_type_set (&set_derived, gfc, BT_DERIVED);
tmp2 = fold_build3_loc (input_location, COND_EXPR, void_type_node, cond,
gfc_finish_block (&set_derived), tmp2);
@@ -2576,8 +2595,7 @@ gfc_set_gfc_from_cfi (stmtblock_t *unconditional_block,
CFI_type_Character));
stmtblock_t set_character;
gfc_init_block (&set_character);
- tree character_value = build_int_cst (TREE_TYPE (type), BT_CHARACTER);
- gfc_conv_descriptor_type_set (&set_character, gfc, character_value);
+ gfc_conv_descriptor_type_set (&set_character, gfc, BT_CHARACTER);
tmp2 = fold_build3_loc (input_location, COND_EXPR, void_type_node, cond,
gfc_finish_block (&set_character), tmp2);
@@ -2591,7 +2609,7 @@ gfc_set_gfc_from_cfi (stmtblock_t *unconditional_block,
build_int_cst (TREE_TYPE (tmp),
CFI_type_ucs4_char));
gfc_init_block (&set_character);
- gfc_conv_descriptor_type_set (&set_character, gfc, character_value);
+ gfc_conv_descriptor_type_set (&set_character, gfc, BT_CHARACTER);
tmp2 = fold_build3_loc (input_location, COND_EXPR, void_type_node, cond,
gfc_finish_block (&set_character), tmp2);
@@ -2601,8 +2619,7 @@ gfc_set_gfc_from_cfi (stmtblock_t *unconditional_block,
CFI_type_Complex));
stmtblock_t set_complex;
gfc_init_block (&set_complex);
- tree complex_value = build_int_cst (TREE_TYPE (type), BT_COMPLEX);
- gfc_conv_descriptor_type_set (&set_complex,
[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] Essai suppression code inutile
https://gcc.gnu.org/g:c8dd6ca3fb39f2b21f7edf0628718f0ae6fb1124
commit c8dd6ca3fb39f2b21f7edf0628718f0ae6fb1124
Author: Mikael Morin
Date: Fri Feb 14 13:50:51 2025 +0100
Essai suppression code inutile
Diff:
---
gcc/fortran/trans-expr.cc | 10 --
1 file changed, 10 deletions(-)
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 13cb7f9fd8fa..44a09f546aa6 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -5320,16 +5320,6 @@ gfc_conv_subref_array_arg (gfc_se *se, gfc_expr * expr,
int g77,
/* Translate the expression. */
gfc_conv_expr (&rse, expr);
- /* Reset the offset for the function call since the loop
- is zero based on the data pointer. Note that the temp
- comes first in the loop chain since it is added second. */
- if (gfc_is_class_array_function (expr))
-{
- tmp = loop.ss->loop_chain->info->data.array.descriptor;
- gfc_conv_descriptor_offset_set (&loop.pre, tmp,
- gfc_index_zero_node);
-}
-
gfc_conv_tmp_array_ref (&lse);
if (intent != INTENT_OUT)
[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] Suppression argument nelems gfc_array_allocate
https://gcc.gnu.org/g:c761a6e18c135f3fdbef79c1da6fc72698816ecd
commit c761a6e18c135f3fdbef79c1da6fc72698816ecd
Author: Mikael Morin
Date: Fri Feb 14 12:11:43 2025 +0100
Suppression argument nelems gfc_array_allocate
Diff:
---
gcc/fortran/trans-array.cc | 6 ++
gcc/fortran/trans-array.h | 2 +-
gcc/fortran/trans-stmt.cc | 5 +
3 files changed, 4 insertions(+), 9 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 891fe662b769..04578f92572e 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -8683,9 +8683,8 @@ retrieve_last_ref (gfc_ref **ref_in, gfc_ref
**prev_ref_in)
bool
gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree status, tree errmsg,
tree errlen, tree label_finish, tree expr3_elem_size,
- tree *nelems, gfc_expr *expr3, tree e3_arr_desc,
- bool e3_has_nodescriptor, gfc_omp_namelist *omp_alloc,
- bool explicit_ts)
+ gfc_expr *expr3, tree e3_arr_desc, bool e3_has_nodescriptor,
+ gfc_omp_namelist *omp_alloc, bool explicit_ts)
{
tree tmp;
tree pointer;
@@ -8822,7 +8821,6 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree
status, tree errmsg,
expr3_elem_size, expr3, e3_arr_desc,
e3_has_nodescriptor, expr, element_size,
explicit_ts, &empty_array_cond);
- *nelems = count;
tree size = get_array_memory_size (element_size, count, empty_array_cond,
&se->pre, &overflow);
diff --git a/gcc/fortran/trans-array.h b/gcc/fortran/trans-array.h
index f37f09c21cff..357bd64fb766 100644
--- a/gcc/fortran/trans-array.h
+++ b/gcc/fortran/trans-array.h
@@ -21,7 +21,7 @@ along with GCC; see the file COPYING3. If not see
/* Generate code to initialize and allocate an array. Statements are added to
se, which should contain an expression for the array descriptor. */
bool gfc_array_allocate (gfc_se *, gfc_expr *, tree, tree, tree, tree,
-tree, tree *, gfc_expr *, tree, bool,
+tree, gfc_expr *, tree, bool,
gfc_omp_namelist *, bool);
/* Allow the bounds of a loop to be set from a callee's array spec. */
diff --git a/gcc/fortran/trans-stmt.cc b/gcc/fortran/trans-stmt.cc
index f4e3ea36cbe3..4406bc6e4ce2 100644
--- a/gcc/fortran/trans-stmt.cc
+++ b/gcc/fortran/trans-stmt.cc
@@ -6394,7 +6394,6 @@ gfc_trans_allocate (gfc_code * code, gfc_omp_namelist
*omp_allocate)
stmtblock_t block;
stmtblock_t post;
stmtblock_t final_block;
- tree nelems;
bool upoly_expr, tmp_expr3_len_flag = false, al_len_needs_set, is_coarray;
bool needs_caf_sync, caf_refs_comp;
bool e3_has_nodescriptor = false;
@@ -6926,7 +6925,6 @@ gfc_trans_allocate (gfc_code * code, gfc_omp_namelist
*omp_allocate)
to handle the complete array allocation. Only the element size
needs to be provided, which is done most of the time by the
pre-evaluation step. */
- nelems = NULL_TREE;
if (expr3_len && (code->expr3->ts.type == BT_CHARACTER
|| code->expr3->ts.type == BT_CLASS))
{
@@ -6998,8 +6996,7 @@ gfc_trans_allocate (gfc_code * code, gfc_omp_namelist
*omp_allocate)
}
if (!gfc_array_allocate (&se, expr, stat, errmsg, errlen,
- label_finish, tmp, &nelems,
- e3rhs ? e3rhs : code->expr3,
+ label_finish, tmp, e3rhs ? e3rhs : code->expr3,
e3_is == E3_DESC ? expr3 : NULL_TREE,
e3_has_nodescriptor, omp_alloc_item,
code->ext.alloc.ts.type != BT_UNKNOWN))
[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] Mise à jour commentaires.
https://gcc.gnu.org/g:f002d571cfa29ce2a678181f64258577a6bba90b
commit f002d571cfa29ce2a678181f64258577a6bba90b
Author: Mikael Morin
Date: Fri Feb 14 12:23:42 2025 +0100
Mise à jour commentaires.
Diff:
---
gcc/fortran/trans-array.cc | 37 ++---
1 file changed, 18 insertions(+), 19 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 04578f92572e..d21e8e774c3a 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -8302,6 +8302,13 @@ descriptor_element_size (tree descriptor, tree
expr3_elem_size,
}
+/* Calculates the memory size of an array, given the size of its elements,
+ the number of them, and the predicate whether the array is empty.
+elements_count = (size_t) elements_count;
+overflow += element_size == 0 ? 0: (MAX/element_size < elements_count ? 1:
0);
+tmp = elements_count * element_size;
+return (tmp); */
+
static tree
get_array_memory_size (tree element_size, tree elements_count,
tree empty_array_cond, stmtblock_t * pblock,
@@ -8316,8 +8323,6 @@ get_array_memory_size (tree element_size, tree
elements_count,
stmtblock_t thenblock;
stmtblock_t elseblock;
-
-
elements_count = fold_convert (size_type_node, elements_count);
/* First check for overflow. Since an array of type character can
@@ -8366,11 +8371,10 @@ get_array_memory_size (tree element_size, tree
elements_count,
}
-/* Fills in an array descriptor, and returns the size of the array.
- The size will be a simple_val, ie a variable or a constant. Also
- calculates the offset of the base. The pointer argument overflow,
- which should be of integer type, will increase in value if overflow
- occurs during the size calculation. Returns the size of the array.
+/* Fills in an array descriptor, and returns the number of elements in the
+ array. The pointer argument overflow, which should be of integer type,
+ will increase in value if overflow occurs during the size calculation.
+ Also sets the condition whether the array is empty through empty_array_cond.
{
stride = 1;
offset = 0;
@@ -8387,13 +8391,9 @@ get_array_memory_size (tree element_size, tree
elements_count,
}
for (n = rank; n < rank+corank; n++)
(Set lcobound/ucobound as above.)
-element_size = sizeof (array element);
-if (!rank)
- return element_size
-stride = (size_t) stride;
-overflow += element_size == 0 ? 0: (MAX/element_size < stride ? 1: 0);
-stride = stride * element_size;
-return (stride);
+if (rank == 0)
+ return 1;
+return stride;
} */
/*GCC ARRAYS*/
@@ -8633,9 +8633,6 @@ gfc_array_init_count (tree descriptor, int rank, int
corank, gfc_expr ** lower,
*empty_array_cond = empty_cond;
- /* The stride is the number of elements in the array, so multiply by the
- size of an element to get the total size. */
-
if (rank == 0)
return gfc_index_one_node;
@@ -8822,8 +8819,10 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree
status, tree errmsg,
e3_has_nodescriptor, expr, element_size,
explicit_ts, &empty_array_cond);
- tree size = get_array_memory_size (element_size, count, empty_array_cond,
-&se->pre, &overflow);
+ tree size = rank == 0
+ ? element_size
+ : get_array_memory_size (element_size, count, empty_array_cond,
+ &se->pre, &overflow);
if (dimension)
{
[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] Renommage gfc_array_init_count -> gfc_descr_init_count
https://gcc.gnu.org/g:8b736715caca8a9c533c7e721e677ed99401f17c commit 8b736715caca8a9c533c7e721e677ed99401f17c Author: Mikael Morin Date: Fri Feb 14 13:46:24 2025 +0100 Renommage gfc_array_init_count -> gfc_descr_init_count Diff: --- gcc/fortran/trans-array.cc | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc index d21e8e774c3a..b121dc94f671 100644 --- a/gcc/fortran/trans-array.cc +++ b/gcc/fortran/trans-array.cc @@ -8398,7 +8398,7 @@ get_array_memory_size (tree element_size, tree elements_count, /*GCC ARRAYS*/ static tree -gfc_array_init_count (tree descriptor, int rank, int corank, gfc_expr ** lower, +gfc_descr_init_count (tree descriptor, int rank, int corank, gfc_expr ** lower, gfc_expr ** upper, stmtblock_t * pblock, stmtblock_t * descriptor_block, tree * overflow, tree expr3_elem_size, gfc_expr *expr3, tree expr3_desc, @@ -8811,7 +8811,7 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree status, tree errmsg, later will mislead the generation of the array dimensions for allocatable/ pointer components in derived types. */ int rank = alloc_w_e3_arr_spec ? expr->rank : ref->u.ar.as->rank; - tree count = gfc_array_init_count (se->expr, rank, + tree count = gfc_descr_init_count (se->expr, rank, coarray ? ref->u.ar.as->corank : 0, lower, upper, &se->pre, &set_descriptor_block, &overflow,
[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] Factorisation descriptor_element_size
https://gcc.gnu.org/g:c141dd194ec615b06b21a493267385487c433cd2
commit c141dd194ec615b06b21a493267385487c433cd2
Author: Mikael Morin
Date: Fri Feb 14 11:04:01 2025 +0100
Factorisation descriptor_element_size
Diff:
---
gcc/fortran/trans-array.cc | 85 +++---
1 file changed, 51 insertions(+), 34 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 8981a420c97a..89c446c396a1 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -8262,6 +8262,46 @@ gfc_conv_descriptor_cosize (tree desc, int rank, int
corank)
}
+static tree
+descriptor_element_size (tree descriptor, tree expr3_elem_size,
+gfc_expr *expr3)
+{
+ tree type;
+ tree tmp;
+
+ type = TREE_TYPE (descriptor);
+
+ /* Obviously, if there is a SOURCE expression (expr3) we must use its element
+ size. */
+ if (expr3_elem_size != NULL_TREE)
+tmp = expr3_elem_size;
+ else if (expr3 != NULL)
+{
+ if (expr3->ts.type == BT_CLASS)
+ {
+ gfc_se se_sz;
+ gfc_expr *sz = gfc_copy_expr (expr3);
+ gfc_add_vptr_component (sz);
+ gfc_add_size_component (sz);
+ gfc_init_se (&se_sz, NULL);
+ gfc_conv_expr (&se_sz, sz);
+ gfc_free_expr (sz);
+ tmp = se_sz.expr;
+ }
+ else
+ {
+ tmp = gfc_typenode_for_spec (&expr3->ts);
+ tmp = TYPE_SIZE_UNIT (tmp);
+ }
+}
+ else
+tmp = TYPE_SIZE_UNIT (gfc_get_element_type (type));
+
+ /* Convert to size_t. */
+ return fold_convert (size_type_node, tmp);
+}
+
+
/* Fills in an array descriptor, and returns the size of the array.
The size will be a simple_val, ie a variable or a constant. Also
calculates the offset of the base. The pointer argument overflow,
@@ -8299,7 +8339,7 @@ gfc_array_init_size (tree descriptor, int rank, int
corank, tree * poffset,
stmtblock_t * descriptor_block, tree * overflow,
tree expr3_elem_size, tree *nelems, gfc_expr *expr3,
tree expr3_desc, bool e3_has_nodescriptor, gfc_expr *expr,
-tree *element_size, bool explicit_ts)
+tree element_size, bool explicit_ts)
{
tree type;
tree tmp;
@@ -8532,37 +8572,10 @@ gfc_array_init_size (tree descriptor, int rank, int
corank, tree * poffset,
}
/* The stride is the number of elements in the array, so multiply by the
- size of an element to get the total size. Obviously, if there is a
- SOURCE expression (expr3) we must use its element size. */
- if (expr3_elem_size != NULL_TREE)
-tmp = expr3_elem_size;
- else if (expr3 != NULL)
-{
- if (expr3->ts.type == BT_CLASS)
- {
- gfc_se se_sz;
- gfc_expr *sz = gfc_copy_expr (expr3);
- gfc_add_vptr_component (sz);
- gfc_add_size_component (sz);
- gfc_init_se (&se_sz, NULL);
- gfc_conv_expr (&se_sz, sz);
- gfc_free_expr (sz);
- tmp = se_sz.expr;
- }
- else
- {
- tmp = gfc_typenode_for_spec (&expr3->ts);
- tmp = TYPE_SIZE_UNIT (tmp);
- }
-}
- else
-tmp = TYPE_SIZE_UNIT (gfc_get_element_type (type));
-
- /* Convert to size_t. */
- *element_size = fold_convert (size_type_node, tmp);
+ size of an element to get the total size. */
if (rank == 0)
-return *element_size;
+return element_size;
*nelems = gfc_evaluate_now (stride, pblock);
stride = fold_convert (size_type_node, stride);
@@ -8572,14 +8585,14 @@ gfc_array_init_size (tree descriptor, int rank, int
corank, tree * poffset,
dividing. */
tmp = fold_build2_loc (input_location, TRUNC_DIV_EXPR,
size_type_node,
-TYPE_MAX_VALUE (size_type_node), *element_size);
+TYPE_MAX_VALUE (size_type_node), element_size);
cond = gfc_unlikely (fold_build2_loc (input_location, LT_EXPR,
logical_type_node, tmp, stride),
PRED_FORTRAN_OVERFLOW);
tmp = fold_build3_loc (input_location, COND_EXPR, integer_type_node, cond,
integer_one_node, integer_zero_node);
cond = gfc_unlikely (fold_build2_loc (input_location, EQ_EXPR,
- logical_type_node, *element_size,
+ logical_type_node, element_size,
build_int_cst (size_type_node, 0)),
PRED_FORTRAN_SIZE_ZERO);
tmp = fold_build3_loc (input_location, COND_EXPR, integer_type_node, cond,
@@ -8589,7 +8602,7 @@ gfc_array_init_size (tree descriptor, int rank, int
corank, tree * poffset,
*overflow = gfc_evaluate_now (tmp, pblock);
size = fold_build2_loc (input_location, MULT_EXPR, size_type_node,
- stride, *element_size);
+ stride, ele
[gcc r15-7526] tree: Fix up the DECL_VALUE_EXPR GC marking [PR118790]
https://gcc.gnu.org/g:74ea20e16cf18b42071557b71a42ea31c8192425
commit r15-7526-g74ea20e16cf18b42071557b71a42ea31c8192425
Author: Jakub Jelinek
Date: Fri Feb 14 12:01:13 2025 +0100
tree: Fix up the DECL_VALUE_EXPR GC marking [PR118790]
The ggc_set_mark call in gt_value_expr_mark_2 is actually wrong, that
just marks the VAR_DECL itself, but doesn't mark the subtrees of it (type
etc.). So, I think we need to test gcc_marked_p for whether it is marked
or not, if not marked walk the DECL_VALUE_EXPR and then gt_ggc_mx mark
the VAR_DECL that was determined not marked and needs to be marked now.
One option would be to call gt_ggc_mx (t) right after the DECL_VALUE_EXPR
walking, but I'm a little bit worried that the subtree marking could mark
other VAR_DECLs (e.g. seen from DECL_SIZE or TREE_TYPE and the like) and
if they would be DECL_HAS_VALUE_EXPR_P we might not walk their
DECL_VALUE_EXPR anymore later.
So, the patch defers the gt_ggc_mx calls until we've walked all the
DECL_VALUE_EXPRs directly or indirectly connected to already marked
VAR_DECLs.
2025-02-14 Jakub Jelinek
PR debug/118790
* tree.cc (struct gt_value_expr_mark_data): New type.
(gt_value_expr_mark_2): Don't call ggc_set_mark, instead check
ggc_marked_p. Treat data as gt_value_expr_mark_data * with pset
in it rather than address of the pset itself and push to be marked
VAR_DECLs into to_mark vec.
(gt_value_expr_mark_1): Change argument from hash_set *
to gt_value_expr_mark_data * and find pset in it.
(gt_value_expr_mark): Pass to traverse_noresize address of
gt_value_expr_mark_data object rather than hash_table and
for all entries in the to_mark vector after the traversal call
gt_ggc_mx.
Diff:
---
gcc/tree.cc | 23 ---
1 file changed, 16 insertions(+), 7 deletions(-)
diff --git a/gcc/tree.cc b/gcc/tree.cc
index 4319f8d41e68..0743ed71c789 100644
--- a/gcc/tree.cc
+++ b/gcc/tree.cc
@@ -211,6 +211,11 @@ struct cl_option_hasher : ggc_cache_ptr_hash
static GTY ((cache)) hash_table *cl_option_hash_table;
+struct gt_value_expr_mark_data {
+ hash_set pset;
+ auto_vec to_mark;
+};
+
/* Callback called through walk_tree_1 to discover DECL_HAS_VALUE_EXPR_P
VAR_DECLs which weren't marked yet, in that case marks them and
walks their DECL_VALUE_EXPR expressions. */
@@ -219,11 +224,12 @@ static tree
gt_value_expr_mark_2 (tree *tp, int *, void *data)
{
tree t = *tp;
- if (VAR_P (t) && DECL_HAS_VALUE_EXPR_P (t) && !ggc_set_mark (t))
+ if (VAR_P (t) && DECL_HAS_VALUE_EXPR_P (t) && !ggc_marked_p (t))
{
tree dve = DECL_VALUE_EXPR (t);
- walk_tree_1 (&dve, gt_value_expr_mark_2, data,
- (hash_set *) data, NULL);
+ gt_value_expr_mark_data *d = (gt_value_expr_mark_data *) data;
+ walk_tree_1 (&dve, gt_value_expr_mark_2, data, &d->pset, NULL);
+ d->to_mark.safe_push (t);
}
return NULL_TREE;
}
@@ -232,10 +238,10 @@ gt_value_expr_mark_2 (tree *tp, int *, void *data)
value_expr_for_decl hash table. */
int
-gt_value_expr_mark_1 (tree_decl_map **e, hash_set *pset)
+gt_value_expr_mark_1 (tree_decl_map **e, gt_value_expr_mark_data *data)
{
if (ggc_marked_p ((*e)->base.from))
-walk_tree_1 (&(*e)->to, gt_value_expr_mark_2, pset, pset, NULL);
+walk_tree_1 (&(*e)->to, gt_value_expr_mark_2, data, &data->pset, NULL);
return 1;
}
@@ -255,8 +261,11 @@ gt_value_expr_mark (hash_table
*h)
if (!h)
return;
- hash_set pset;
- h->traverse_noresize *, gt_value_expr_mark_1> (&pset);
+ gt_value_expr_mark_data data;
+ h->traverse_noresize (&data);
+ for (auto v : data.to_mark)
+gt_ggc_mx (v);
}
/* General tree->tree mapping structure for use in hash tables. */
[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] Mise à jour offset & span dans gfc_array_init_size
https://gcc.gnu.org/g:537d11778347885424c87b8aebe23ea97bcdd462
commit 537d11778347885424c87b8aebe23ea97bcdd462
Author: Mikael Morin
Date: Fri Feb 14 11:22:35 2025 +0100
Mise à jour offset & span dans gfc_array_init_size
Diff:
---
gcc/fortran/trans-array.cc | 34 --
1 file changed, 12 insertions(+), 22 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 89c446c396a1..ca7590b8f7b7 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -8334,8 +8334,8 @@ descriptor_element_size (tree descriptor, tree
expr3_elem_size,
/*GCC ARRAYS*/
static tree
-gfc_array_init_size (tree descriptor, int rank, int corank, tree * poffset,
-gfc_expr ** lower, gfc_expr ** upper, stmtblock_t * pblock,
+gfc_array_init_size (tree descriptor, int rank, int corank, gfc_expr ** lower,
+gfc_expr ** upper, stmtblock_t * pblock,
stmtblock_t * descriptor_block, tree * overflow,
tree expr3_elem_size, tree *nelems, gfc_expr *expr3,
tree expr3_desc, bool e3_has_nodescriptor, gfc_expr *expr,
@@ -8577,6 +8577,12 @@ gfc_array_init_size (tree descriptor, int rank, int
corank, tree * poffset,
if (rank == 0)
return element_size;
+ /* Update the array descriptor with the offset and the span. */
+ offset = gfc_evaluate_now (offset, pblock);
+ gfc_conv_descriptor_offset_set (descriptor_block, descriptor, offset);
+ tmp = fold_convert (gfc_array_index_type, element_size);
+ gfc_conv_descriptor_span_set (descriptor_block, descriptor, tmp);
+
*nelems = gfc_evaluate_now (stride, pblock);
stride = fold_convert (size_type_node, stride);
@@ -8604,12 +8610,6 @@ gfc_array_init_size (tree descriptor, int rank, int
corank, tree * poffset,
size = fold_build2_loc (input_location, MULT_EXPR, size_type_node,
stride, element_size);
- if (poffset != NULL)
-{
- offset = gfc_evaluate_now (offset, pblock);
- *poffset = offset;
-}
-
if (integer_zerop (or_expr))
return size;
if (integer_onep (or_expr))
@@ -8672,7 +8672,6 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree
status, tree errmsg,
{
tree tmp;
tree pointer;
- tree offset = NULL_TREE;
tree token = NULL_TREE;
tree size;
tree msg;
@@ -8801,11 +8800,10 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree
status, tree errmsg,
size = gfc_array_init_size (se->expr, alloc_w_e3_arr_spec ? expr->rank
: ref->u.ar.as->rank,
coarray ? ref->u.ar.as->corank : 0,
- &offset, lower, upper,
- &se->pre, &set_descriptor_block, &overflow,
- expr3_elem_size, nelems, expr3, e3_arr_desc,
- e3_has_nodescriptor, expr, element_size,
- explicit_ts);
+ lower, upper, &se->pre, &set_descriptor_block,
+ &overflow, expr3_elem_size, nelems, expr3,
+ e3_arr_desc, e3_has_nodescriptor, expr,
+ element_size, explicit_ts);
if (dimension)
{
@@ -8942,14 +8940,6 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree
status, tree errmsg,
gfc_add_expr_to_block (&se->pre, tmp);
- /* Update the array descriptor with the offset and the span. */
- if (dimension)
-{
- gfc_conv_descriptor_offset_set (&set_descriptor_block, se->expr, offset);
- tmp = fold_convert (gfc_array_index_type, element_size);
- gfc_conv_descriptor_span_set (&set_descriptor_block, se->expr, tmp);
-}
-
set_descriptor = gfc_finish_block (&set_descriptor_block);
if (status != NULL_TREE)
{
[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] Séparation get_array_memory_size
https://gcc.gnu.org/g:5b2a88f775bfcb66e3b0bfda584a7592c2c39fdb
commit 5b2a88f775bfcb66e3b0bfda584a7592c2c39fdb
Author: Mikael Morin
Date: Fri Feb 14 12:07:08 2025 +0100
Séparation get_array_memory_size
Diff:
---
gcc/fortran/trans-array.cc | 160 ++---
1 file changed, 91 insertions(+), 69 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index ca7590b8f7b7..891fe662b769 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -8302,6 +8302,70 @@ descriptor_element_size (tree descriptor, tree
expr3_elem_size,
}
+static tree
+get_array_memory_size (tree element_size, tree elements_count,
+ tree empty_array_cond, stmtblock_t * pblock,
+ tree * overflow)
+{
+ tree tmp;
+ tree size;
+ tree thencase;
+ tree elsecase;
+ tree cond;
+ tree var;
+ stmtblock_t thenblock;
+ stmtblock_t elseblock;
+
+
+
+ elements_count = fold_convert (size_type_node, elements_count);
+
+ /* First check for overflow. Since an array of type character can
+ have zero element_size, we must check for that before
+ dividing. */
+ tmp = fold_build2_loc (input_location, TRUNC_DIV_EXPR,
+size_type_node,
+TYPE_MAX_VALUE (size_type_node), element_size);
+ cond = gfc_unlikely (fold_build2_loc (input_location, LT_EXPR,
+ logical_type_node, tmp, elements_count),
+ PRED_FORTRAN_OVERFLOW);
+ tmp = fold_build3_loc (input_location, COND_EXPR, integer_type_node, cond,
+integer_one_node, integer_zero_node);
+ cond = gfc_unlikely (fold_build2_loc (input_location, EQ_EXPR,
+ logical_type_node, element_size,
+ build_int_cst (size_type_node, 0)),
+ PRED_FORTRAN_SIZE_ZERO);
+ tmp = fold_build3_loc (input_location, COND_EXPR, integer_type_node, cond,
+integer_zero_node, tmp);
+ tmp = fold_build2_loc (input_location, PLUS_EXPR, integer_type_node,
+*overflow, tmp);
+ *overflow = gfc_evaluate_now (tmp, pblock);
+
+ size = fold_build2_loc (input_location, MULT_EXPR, size_type_node,
+ elements_count, element_size);
+
+ if (integer_zerop (empty_array_cond))
+return size;
+ if (integer_onep (empty_array_cond))
+return build_int_cst (size_type_node, 0);
+
+ var = gfc_create_var (TREE_TYPE (size), "size");
+ gfc_start_block (&thenblock);
+ gfc_add_modify (&thenblock, var, build_int_cst (size_type_node, 0));
+ thencase = gfc_finish_block (&thenblock);
+
+ gfc_start_block (&elseblock);
+ gfc_add_modify (&elseblock, var, size);
+ elsecase = gfc_finish_block (&elseblock);
+
+ tmp = gfc_evaluate_now (empty_array_cond, pblock);
+ tmp = build3_v (COND_EXPR, tmp, thencase, elsecase);
+ gfc_add_expr_to_block (pblock, tmp);
+
+ return var;
+}
+
+
/* Fills in an array descriptor, and returns the size of the array.
The size will be a simple_val, ie a variable or a constant. Also
calculates the offset of the base. The pointer argument overflow,
@@ -8334,25 +8398,20 @@ descriptor_element_size (tree descriptor, tree
expr3_elem_size,
/*GCC ARRAYS*/
static tree
-gfc_array_init_size (tree descriptor, int rank, int corank, gfc_expr ** lower,
-gfc_expr ** upper, stmtblock_t * pblock,
-stmtblock_t * descriptor_block, tree * overflow,
-tree expr3_elem_size, tree *nelems, gfc_expr *expr3,
-tree expr3_desc, bool e3_has_nodescriptor, gfc_expr *expr,
-tree element_size, bool explicit_ts)
+gfc_array_init_count (tree descriptor, int rank, int corank, gfc_expr ** lower,
+ gfc_expr ** upper, stmtblock_t * pblock,
+ stmtblock_t * descriptor_block, tree * overflow,
+ tree expr3_elem_size, gfc_expr *expr3, tree expr3_desc,
+ bool e3_has_nodescriptor, gfc_expr *expr,
+ tree element_size, bool explicit_ts,
+ tree *empty_array_cond)
{
tree type;
tree tmp;
tree size;
tree offset;
tree stride;
- tree or_expr;
- tree thencase;
- tree elsecase;
tree cond;
- tree var;
- stmtblock_t thenblock;
- stmtblock_t elseblock;
gfc_expr *ubound;
gfc_se se;
int n;
@@ -8406,7 +8465,7 @@ gfc_array_init_size (tree descriptor, int rank, int
corank, gfc_expr ** lower,
else
gfc_conv_descriptor_dtype_set (pblock, descriptor, gfc_get_dtype (type));
- or_expr = logical_false_node;
+ tree empty_cond = logical_false_node;
for (n = 0; n < rank; n++)
{
@@ -8499,7 +8558,8 @@ gfc_array_init_size (tree descriptor, int rank, int
corank, gfc_expr ** lower,
gfc_rank_cst[n], stride);
/* Calculate size and check whethe
[gcc r15-7527] c++: fix propagating REF_PARENTHESIZED_P [PR116379]
https://gcc.gnu.org/g:b01664a6197f57615d3c62594037c575dfdd9035
commit r15-7527-gb01664a6197f57615d3c62594037c575dfdd9035
Author: Marek Polacek
Date: Thu Feb 13 15:56:16 2025 -0500
c++: fix propagating REF_PARENTHESIZED_P [PR116379]
Here we have:
template
struct X{
T val;
decltype(auto) value(){
return (val);
}
};
where the return type of value should be 'int &' since '(val)' is an
expression, not a name, and decltype(auto) performs the type deduction
using the decltype rules.
The problem is that we weren't propagating REF_PARENTHESIZED_P
correctly: the return value of finish_non_static_data_member in this
test was a REFERENCE_REF_P, so we didn't set the flag. We should
use force_paren_expr like below.
PR c++/116379
gcc/cp/ChangeLog:
* pt.cc (tsubst_expr) : Use force_paren_expr to set
REF_PARENTHESIZED_P.
gcc/testsuite/ChangeLog:
* g++.dg/cpp1y/decltype-auto9.C: New test.
Reviewed-by: Jason Merrill
Diff:
---
gcc/cp/pt.cc| 4 ++--
gcc/testsuite/g++.dg/cpp1y/decltype-auto9.C | 15 +++
2 files changed, 17 insertions(+), 2 deletions(-)
diff --git a/gcc/cp/pt.cc b/gcc/cp/pt.cc
index a2fc8813e9de..5706a3987c34 100644
--- a/gcc/cp/pt.cc
+++ b/gcc/cp/pt.cc
@@ -21712,8 +21712,8 @@ tsubst_expr (tree t, tree args, tsubst_flags_t
complain, tree in_decl)
{
r = finish_non_static_data_member (member, object, NULL_TREE,
complain);
- if (TREE_CODE (r) == COMPONENT_REF)
- REF_PARENTHESIZED_P (r) = REF_PARENTHESIZED_P (t);
+ if (REF_PARENTHESIZED_P (t))
+ force_paren_expr (r);
RETURN (r);
}
else if (type_dependent_expression_p (object))
diff --git a/gcc/testsuite/g++.dg/cpp1y/decltype-auto9.C
b/gcc/testsuite/g++.dg/cpp1y/decltype-auto9.C
new file mode 100644
index ..1ccf95a01702
--- /dev/null
+++ b/gcc/testsuite/g++.dg/cpp1y/decltype-auto9.C
@@ -0,0 +1,15 @@
+// PR c++/116379
+// { dg-do compile { target c++14 } }
+
+template
+struct X {
+ T val;
+ decltype(auto) value() { return (val); }
+};
+
+int main() {
+ int i = 0;
+ X x{ static_cast(i) };
+ using type = decltype(x.value());
+ using type = int&;
+}
[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] Correction class_result_10.f90
https://gcc.gnu.org/g:4cc360ef650f45f0a1ace577ab663b9ed7ef777c commit 4cc360ef650f45f0a1ace577ab663b9ed7ef777c Author: Mikael Morin Date: Fri Feb 14 18:48:22 2025 +0100 Correction class_result_10.f90 Diff: --- gcc/fortran/trans-array.cc | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc index 4120785b49b5..c8e5fa60067a 100644 --- a/gcc/fortran/trans-array.cc +++ b/gcc/fortran/trans-array.cc @@ -7445,7 +7445,8 @@ done: int dim = ss->dim[n]; info->start[dim] = gfc_index_zero_node; - info->end[dim]= gfc_index_zero_node; + if (ss_info->type != GFC_SS_FUNCTION) + info->end[dim]= gfc_index_zero_node; info->stride[dim] = gfc_index_one_node; } break;
[gcc r15-7534] c++: add fixed test [PR66519]
https://gcc.gnu.org/g:9a6758edc229abc0ed0f5ce65958082b3e8a8502
commit r15-7534-g9a6758edc229abc0ed0f5ce65958082b3e8a8502
Author: Marek Polacek
Date: Fri Feb 14 13:14:01 2025 -0500
c++: add fixed test [PR66519]
Fixed by r10-6464.
PR c++/66519
gcc/testsuite/ChangeLog:
* g++.dg/cpp0x/variadic-parm2.C: New test.
Diff:
---
gcc/testsuite/g++.dg/cpp0x/variadic-parm2.C | 12
1 file changed, 12 insertions(+)
diff --git a/gcc/testsuite/g++.dg/cpp0x/variadic-parm2.C
b/gcc/testsuite/g++.dg/cpp0x/variadic-parm2.C
new file mode 100644
index ..b061adbd7a95
--- /dev/null
+++ b/gcc/testsuite/g++.dg/cpp0x/variadic-parm2.C
@@ -0,0 +1,12 @@
+// PR c++/66519
+// { dg-do compile { target c++11 } }
+
+template
+void a(F f, Tp... args, decltype(f(args...)) = 1) {}
+
+template
+void a(F, Tp...) {}
+
+void b(void) {
+a([]{});
+}
[gcc r15-7533] tree-optimization/118852 - wrong code with 502.gcc_r
https://gcc.gnu.org/g:589d79e6268b055422a7b6c11cd0a8a4f2531a8c
commit r15-7533-g589d79e6268b055422a7b6c11cd0a8a4f2531a8c
Author: Richard Biener
Date: Fri Feb 14 14:48:41 2025 +0100
tree-optimization/118852 - wrong code with 502.gcc_r
502.gcc_r when built with -fprofile-generate exposes a SLP discovery
issue where an IV forced live due to early break is not properly
discovered if its latch def is part of a different IVs SSA cycle.
To mitigate this we have to make sure to create an SLP instance
for the original IV. Ideally we'd handle all vect_induction_def
the same but this is left for next stage1.
PR tree-optimization/118852
* tree-vect-slp.cc (vect_analyze_slp): For early-break
forced-live IVs make sure we create an appropriate
entry into the SLP graph.
* gcc.dg/vect/pr118852.c: New testcase.
Diff:
---
gcc/testsuite/gcc.dg/vect/pr118852.c | 105 +++
gcc/tree-vect-slp.cc | 24 +++-
2 files changed, 126 insertions(+), 3 deletions(-)
diff --git a/gcc/testsuite/gcc.dg/vect/pr118852.c
b/gcc/testsuite/gcc.dg/vect/pr118852.c
new file mode 100644
index ..d6b43378d6f4
--- /dev/null
+++ b/gcc/testsuite/gcc.dg/vect/pr118852.c
@@ -0,0 +1,105 @@
+/* { dg-add-options vect_early_break } */
+/* { dg-require-profiling "-fprofile-generate" } */
+/* { dg-additional-options "-fallow-store-data-races -fprofile-arcs" } */
+/* { dg-additional-options "-msse4.2 -mprefer-vector-width=128" { target {
x86_64-*-* i?86-*-* } } } */
+
+#include "tree-vect.h"
+
+typedef unsigned int hashval_t;
+struct htab {
+ void ** entries;
+ unsigned long size;
+};
+typedef struct htab *htab_t;
+unsigned long htab_size (htab_t h)
+{
+ return h->size;
+}
+typedef struct
+{
+ htab_t htab;
+ void * *slot;
+ void * *limit;
+} htab_iterator;
+
+static inline void *
+first_htab_element (htab_iterator *hti, htab_t table)
+{
+ hti->htab = table;
+ hti->slot = table->entries;
+ hti->limit = hti->slot + htab_size (table);
+ do
+{
+ void * x = *(hti->slot);
+ if (x != ((void *) 0) && x != ((void *) 1))
+ break;
+} while (++(hti->slot) < hti->limit);
+
+ if (hti->slot < hti->limit)
+return *(hti->slot);
+ return (void *) 0;
+}
+
+static inline unsigned char
+end_htab_p (const htab_iterator *hti)
+{
+ if (hti->slot >= hti->limit)
+return 1;
+ return 0;
+}
+
+static inline void *
+next_htab_element (htab_iterator *hti)
+{
+ while (++(hti->slot) < hti->limit)
+{
+ void * x = *(hti->slot);
+ if (x != ((void *) 0) && x != ((void *) 1))
+ return x;
+}
+ return (void *) 0;
+}
+
+typedef unsigned long vn_nary_op_t;
+
+typedef struct vn_tables_s
+{
+ htab_t nary;
+} *vn_tables_t;
+
+vn_tables_t valid_info;
+
+void __attribute__((noipa))
+announce (vn_nary_op_t p)
+{
+ static vn_nary_op_t prev = 0;
+ if (prev == 0x70904f0 && p != 0x70904c0)
+__builtin_abort ();
+ prev = p;
+}
+
+void __attribute__((noipa))
+set_hashtable_value_ids_1 (void)
+{
+ htab_iterator hi;
+ vn_nary_op_t vno;
+ for (vno = (vn_nary_op_t) first_htab_element (&(hi), (valid_info->nary));
!end_htab_p (&(hi)); vno = (vn_nary_op_t) next_htab_element (&(hi)))
+announce (vno);
+}
+
+int main()
+{
+ if (sizeof (void *) != sizeof (vn_nary_op_t))
+return 0;
+ check_vect ();
+ valid_info = __builtin_malloc (sizeof (struct vn_tables_s));
+ valid_info->nary = __builtin_malloc (sizeof (struct htab));
+ valid_info->nary->entries = __builtin_malloc (sizeof (void *) * 32);
+ valid_info->nary->size = 31;
+ static vn_nary_op_t x[] = { 0x70905e0, 0x0, 0x0, 0x7090610, 0x7090550,
0x7090400, 0x70903a0, 0x0,
+ 0x0, 0x70904f0, 0x0, 0x0, 0x0, 0x0, 0x70904c0, 0x7090520, 0x7090460,
+ 0x7090490, 0x7090430, 0x0, 0x0, 0x0, 0x7090640, 0x0, 0x0, 0x70903d0,
0x0,
+ 0x7090580, 0x0, 0x0, 0x70905b0};
+ __builtin_memcpy (valid_info->nary->entries, x, sizeof (void *) * 31);
+ set_hashtable_value_ids_1 ();
+}
diff --git a/gcc/tree-vect-slp.cc b/gcc/tree-vect-slp.cc
index 8ed746ea5a9e..9e09f8e980b5 100644
--- a/gcc/tree-vect-slp.cc
+++ b/gcc/tree-vect-slp.cc
@@ -5031,15 +5031,33 @@ vect_analyze_slp (vec_info *vinfo, unsigned
max_tree_size,
vec stmts;
vec roots = vNULL;
vec remain = vNULL;
- gphi *lc_phi = as_a (STMT_VINFO_STMT (stmt_info));
- tree def = gimple_phi_arg_def_from_edge (lc_phi, latch_e);
- stmt_vec_info lc_info = loop_vinfo->lookup_def (def);
+ gphi *phi = as_a (STMT_VINFO_STMT (stmt_info));
stmts.create (1);
+ tree def = gimple_phi_arg_def_from_edge (phi, latch_e);
+ stmt_vec_info lc_info = loop_vinfo->lookup_def (def);
stmts.quick_push (vect_stmt_to_vectorize (lc_info));
vect_build_slp_instance (vinfo, slp_inst_kind_reduc_group,
stmts, roots, remain,
[gcc r14-11310] [PATCH] PR modula2/118761: gm2 driver doesnt behave as gcc for -fhelp=BLA
https://gcc.gnu.org/g:9c38d0a79caef1909df9f51ec8d17c5f8cfecabd commit r14-11310-g9c38d0a79caef1909df9f51ec8d17c5f8cfecabd Author: Gaius Mulley Date: Fri Feb 14 19:17:02 2025 + [PATCH] PR modula2/118761: gm2 driver doesnt behave as gcc for -fhelp=BLA This patch enables the gm2 driver to handle -fsyntax-only -fhelp=optimizers, for example, correctly without terminating with gm2: fatal error: no input files. gcc/m2/ChangeLog: PR modula2/118761 * gm2spec.cc (lang_specific_driver): Add case clauses for OPT__help, OPT__help_ set in_added_libraries to 0 and early return. (cherry picked from commit 3c5422e719d1fbabccaa9b63605171ea8bdfe57e) Signed-off-by: Gaius Mulley Diff: --- gcc/m2/gm2spec.cc | 6 ++ 1 file changed, 6 insertions(+) diff --git a/gcc/m2/gm2spec.cc b/gcc/m2/gm2spec.cc index 2a4dccf8b93c..d1fefdcc27c7 100644 --- a/gcc/m2/gm2spec.cc +++ b/gcc/m2/gm2spec.cc @@ -576,6 +576,12 @@ lang_specific_driver (struct cl_decoded_option **in_decoded_options, args[i] |= SKIPOPT; /* We will add the option if it is needed. */ m2_path_name = decoded_options[i].arg; break; + case OPT__help: + case OPT__help_: + /* Let gcc.cc handle this, as it has a really +cool facility for handling --help and --verbose --help. */ + *in_added_libraries = 0; + return; case OPT_I: args[i] |= SKIPOPT; /* We will add the option if it is needed. */ push_back_Ipath (decoded_options[i].arg);
[gcc r14-11309] Fortran: fix initialization of allocatable non-deferred character [PR59252]
https://gcc.gnu.org/g:5ec7193faa7a5a78dd5382aec220a49f4a76a976
commit r14-11309-g5ec7193faa7a5a78dd5382aec220a49f4a76a976
Author: Harald Anlauf
Date: Fri Feb 7 21:21:10 2025 +0100
Fortran: fix initialization of allocatable non-deferred character [PR59252]
PR fortran/59252
gcc/fortran/ChangeLog:
* trans-expr.cc (gfc_trans_subcomponent_assign): Initialize
allocatable non-deferred character with NULL properly.
gcc/testsuite/ChangeLog:
* gfortran.dg/allocatable_char_1.f90: New test.
(cherry picked from commit 818c36a85e3faec5442eb26799bfa3bba7764b36)
Diff:
---
gcc/fortran/trans-expr.cc| 8 +++-
gcc/testsuite/gfortran.dg/allocatable_char_1.f90 | 47
2 files changed, 53 insertions(+), 2 deletions(-)
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 601cc546d438..f6de2227675b 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -9407,9 +9407,13 @@ gfc_trans_subcomponent_assign (tree dest, gfc_component
* cm,
tmp = gfc_trans_alloc_subarray_assign (tmp, cm, expr);
gfc_add_expr_to_block (&block, tmp);
}
- else if (init && cm->attr.allocatable && expr->expr_type == EXPR_NULL)
+ else if (cm->attr.allocatable && expr->expr_type == EXPR_NULL
+ && (init
+ || (cm->ts.type == BT_CHARACTER
+ && !(cm->ts.deferred || cm->attr.pdt_string
{
- /* NULL initialization for allocatable components. */
+ /* NULL initialization for allocatable components.
+Deferred-length character is dealt with later. */
gfc_add_modify (&block, dest, fold_convert (TREE_TYPE (dest),
null_pointer_node));
}
diff --git a/gcc/testsuite/gfortran.dg/allocatable_char_1.f90
b/gcc/testsuite/gfortran.dg/allocatable_char_1.f90
new file mode 100644
index ..1d6c25c4942d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/allocatable_char_1.f90
@@ -0,0 +1,47 @@
+! { dg-do run }
+! { dg-additional-options "-fdump-tree-original" }
+!
+! PR fortran/59252
+
+module mod
+ implicit none
+
+ type t1
+ character(256), allocatable :: label
+ end type t1
+
+ type t2
+ type(t1), allocatable :: appv(:)
+ end type t2
+
+contains
+ subroutine construct(res)
+type(t2), allocatable, intent(inout) :: res
+if (.not. allocated(res)) allocate(res)
+ end subroutine construct
+
+ subroutine construct_appv(appv)
+type(t1), allocatable, intent(inout) :: appv(:)
+if (.not. allocated(appv)) allocate(appv(20))
+ end subroutine construct_appv
+
+ type(t1) function foo () result (res)
+ end function foo
+end module mod
+
+program testy
+ use mod
+ implicit none
+ type(t2), allocatable :: res
+ type(t1) :: s
+
+ ! original test from pr59252
+ call construct (res)
+ call construct_appv(res%appv)
+ deallocate (res)
+
+ ! related test from pr118747 comment 2:
+ s = foo ()
+end program testy
+
+! { dg-final { scan-tree-dump-not "__builtin_memmove" "original" } }
[gcc r15-7535] c++: add fixed test [PR66878]
https://gcc.gnu.org/g:720137f4ee6e80de5c22b9f9c9750f13b2132fe6
commit r15-7535-g720137f4ee6e80de5c22b9f9c9750f13b2132fe6
Author: Marek Polacek
Date: Fri Feb 14 13:48:03 2025 -0500
c++: add fixed test [PR66878]
Fixed by r11-175.
PR c++/66878
gcc/testsuite/ChangeLog:
* g++.dg/lookup/using71.C: New test.
Diff:
---
gcc/testsuite/g++.dg/lookup/using71.C | 12
1 file changed, 12 insertions(+)
diff --git a/gcc/testsuite/g++.dg/lookup/using71.C
b/gcc/testsuite/g++.dg/lookup/using71.C
new file mode 100644
index ..b899e0a27a30
--- /dev/null
+++ b/gcc/testsuite/g++.dg/lookup/using71.C
@@ -0,0 +1,12 @@
+// PR c++/66878
+
+struct S;
+
+namespace H {
+namespace P {
+using ::S;
+}
+struct P::S {};
+}
+
+int main() {}
[gcc r15-7528] libstdc++: Conditionally use floating-point fetch_add builtins
https://gcc.gnu.org/g:5ced917508eee7eb499e19feeb3def1fa1842bb4
commit r15-7528-g5ced917508eee7eb499e19feeb3def1fa1842bb4
Author: Matthew Malcomson
Date: Fri Feb 7 14:49:11 2025 +
libstdc++: Conditionally use floating-point fetch_add builtins
- Some hardware has support for floating point atomic fetch_add (and
similar).
- There are existing compilers targetting this hardware that use
libstdc++ -- e.g. NVC++.
- Since the libstdc++ atomic::fetch_add and similar is written
directly as a CAS loop these compilers can not emit optimal code when
seeing such constructs.
- I hope to use __atomic_fetch_add builtins on floating point types
directly in libstdc++ so these compilers can emit better code.
- Clang already handles some floating point types in the
__atomic_fetch_add family of builtins.
- In order to only use this when available, I originally thought I could
check against the resolved versions of the builtin in a manner
something like `__has_builtin(__atomic_fetch_add_)`.
I then realised that clang does not expose resolved versions of these
atomic builtins to the user.
From the clang discourse it was suggested we instead use SFINAE (which
clang already supports).
- I have recently pushed a patch for allowing the use of SFINAE on
builtins: r15-6042-g9ed094a817ecaf
Now that patch is committed, this patch does not change what happens
for GCC, while it uses the builtin for codegen with clang.
- I have previously sent a patchset upstream adding the ability to use
__atomic_fetch_add and similar on floating point types.
https://gcc.gnu.org/pipermail/gcc-patches/2024-November/668754.html
Once that patchset is upstream (plus the automatic linking of
libatomic as Joseph pointed out in the email below
https://gcc.gnu.org/pipermail/gcc-patches/2024-October/665408.html )
then current GCC should start to use the builtin branch added in this
patch.
So *currently*, this patch allows external compilers (NVC++ in
particular) to generate better code, and similarly lets clang understand
the operation better since it maps to a known builtin.
I hope that by GCC 16 this patch would also allow GCC to understand the
operation better via mapping to a known builtin.
libstdc++-v3/ChangeLog:
* include/bits/atomic_base.h (__atomic_fetch_addable): Define
new concept.
(__atomic_impl::__fetch_add_flt): Use new concept to make use of
__atomic_fetch_add when available.
(__atomic_fetch_subtractable, __fetch_sub_flt): Likewise.
(__atomic_add_fetchable, __add_fetch_flt): Likewise.
(__atomic_sub_fetchable, __sub_fetch_flt): Likewise.
Signed-off-by: Matthew Malcomson
Co-authored-by: Jonathan Wakely
Diff:
---
libstdc++-v3/include/bits/atomic_base.h | 88 +++--
1 file changed, 62 insertions(+), 26 deletions(-)
diff --git a/libstdc++-v3/include/bits/atomic_base.h
b/libstdc++-v3/include/bits/atomic_base.h
index 1ef21f30bbce..b56007b7bf5f 100644
--- a/libstdc++-v3/include/bits/atomic_base.h
+++ b/libstdc++-v3/include/bits/atomic_base.h
@@ -1209,54 +1209,90 @@ _GLIBCXX_BEGIN_NAMESPACE_VERSION
__xor_fetch(_Tp* __ptr, _Val<_Tp> __i) noexcept
{ return __atomic_xor_fetch(__ptr, __i, __ATOMIC_SEQ_CST); }
+template
+ concept __atomic_fetch_addable
+ = requires (_Tp __t) { __atomic_fetch_add(&__t, __t, 0); };
+
template
_Tp
__fetch_add_flt(_Tp* __ptr, _Val<_Tp> __i, memory_order __m) noexcept
{
- _Val<_Tp> __oldval = load(__ptr, memory_order_relaxed);
- _Val<_Tp> __newval = __oldval + __i;
- while (!compare_exchange_weak(__ptr, __oldval, __newval, __m,
- memory_order_relaxed))
- __newval = __oldval + __i;
- return __oldval;
+ if constexpr (__atomic_fetch_addable<_Tp>)
+ return __atomic_fetch_add(__ptr, __i, int(__m));
+ else
+ {
+ _Val<_Tp> __oldval = load (__ptr, memory_order_relaxed);
+ _Val<_Tp> __newval = __oldval + __i;
+ while (!compare_exchange_weak (__ptr, __oldval, __newval, __m,
+ memory_order_relaxed))
+ __newval = __oldval + __i;
+ return __oldval;
+ }
}
+template
+ concept __atomic_fetch_subtractable
+ = requires (_Tp __t) { __atomic_fetch_sub(&__t, __t, 0); };
+
template
_Tp
__fetch_sub_flt(_Tp* __ptr, _Val<_Tp> __i, memory_order __m) noexcept
{
- _Val<_Tp> __oldval = load(__ptr, memory_order_relaxed);
- _Val<_Tp> __newval = __oldval - __i;
- while (!compare_exchange_weak(__ptr, __oldval, __newval, __m,
- memory_order_relaxed))
- __newval
[gcc r15-7532] c++: extended temp cleanups [PR118856]
https://gcc.gnu.org/g:e96e1bb69c7b46db18e747ee379a62681bc8c82d
commit r15-7532-ge96e1bb69c7b46db18e747ee379a62681bc8c82d
Author: Jason Merrill
Date: Fri Feb 14 10:53:01 2025 +0100
c++: extended temp cleanups [PR118856]
A later testcase in PR118856 highlights a preexisting problem with multiple
reference-extended temporaries in a single declaration; if initializing a
later one throws, the cleanup for the earlier one is not in scope yet.
Let's deal with this by keeping a dummy TARGET_EXPR to hold the EH cleanup
until all other initialization is complete. See the comment for various
other considered approaches.
We now avoid extending TARGET_EXPRs with CLEANUP_EH_ONLY set; all such
TARGET_EXPRs were already only internal iterator/flag variables that don't
want to be extended, as they are dead after initialization is complete even
if other temporaries are extended. But some other internal temporaries did
not have the flag set because they don't have TARGET_EXPR_CLEANUP; I
introduce a get_internal_target_expr function to set the flag rather than
directly set the flag (and add a comment) in such places. The places
changed to call get_internal_target_expr either already set the flag, or
have no cleanup at all.
PR c++/118856
gcc/cp/ChangeLog:
* call.cc (set_up_extended_ref_temp): Retain a TARGET_EXPR for
cleanups if something later in initialization throws.
(extend_temps_r): Don't extend eliding or EH-only TARGET_EXPRs.
* cp-tree.h (get_internal_target_expr): Declare.
* tree.cc (get_internal_target_expr): New.
* decl.cc (cp_finish_decomp, expand_static_init): Use it.
* except.cc (build_throw): Likewise.
* init.cc (build_new_1, build_vec_init, build_delete): Likewise.
(build_vec_delete): Likewise.
* typeck2.cc (maybe_push_temp_cleanup): Likewise.
gcc/testsuite/ChangeLog:
* g++.dg/eh/ref-temp3.C: New test.
* g++.dg/eh/ref-temp4.C: New test.
Diff:
---
gcc/cp/cp-tree.h| 1 +
gcc/cp/call.cc | 40 -
gcc/cp/decl.cc | 4 ++--
gcc/cp/except.cc| 2 +-
gcc/cp/init.cc | 16 +++
gcc/cp/tree.cc | 21 +++
gcc/cp/typeck2.cc | 2 +-
gcc/testsuite/g++.dg/eh/ref-temp3.C | 36 +
gcc/testsuite/g++.dg/eh/ref-temp4.C | 35
9 files changed, 144 insertions(+), 13 deletions(-)
diff --git a/gcc/cp/cp-tree.h b/gcc/cp/cp-tree.h
index b7749eb2b327..d87cc1555b7a 100644
--- a/gcc/cp/cp-tree.h
+++ b/gcc/cp/cp-tree.h
@@ -8207,6 +8207,7 @@ extern bool is_local_temp (tree);
extern tree build_aggr_init_expr (tree, tree);
extern tree get_target_expr(tree,
tsubst_flags_t =
tf_warning_or_error);
+extern tree get_internal_target_expr (tree);
extern tree build_cplus_array_type (tree, tree, int is_dep = -1);
extern tree build_array_of_n_type (tree, unsigned HOST_WIDE_INT);
extern bool array_of_runtime_bound_p (tree);
diff --git a/gcc/cp/call.cc b/gcc/cp/call.cc
index 38a8f7fdcda9..03130f80f861 100644
--- a/gcc/cp/call.cc
+++ b/gcc/cp/call.cc
@@ -14251,6 +14251,8 @@ set_up_extended_ref_temp (tree decl, tree expr,
vec **cleanups,
init = add_stmt_to_compound (init, register_dtor_fn (var));
else
{
+ /* ??? Instead of rebuilding the cleanup, we could replace the slot
+with var in TARGET_EXPR_CLEANUP (expr). */
tree cleanup = cxx_maybe_build_cleanup (var, tf_warning_or_error);
if (cleanup)
{
@@ -14269,6 +14271,37 @@ set_up_extended_ref_temp (tree decl, tree expr,
vec **cleanups,
cleanup = build3 (COND_EXPR, void_type_node,
*cond_guard, cleanup, NULL_TREE);
}
+ if (flag_exceptions && TREE_CODE (TREE_TYPE (var)) != ARRAY_TYPE)
+ {
+ /* The normal cleanup for this extended variable isn't pushed
+until cp_finish_decl, so we need to retain a TARGET_EXPR
+to clean it up in case a later initializer throws
+(g++.dg/eh/ref-temp3.C).
+
+We don't do this for array temporaries because they have
+the array cleanup region from build_vec_init.
+
+Unlike maybe_push_temp_cleanup, we don't actually need a
+flag, but a TARGET_EXPR needs a TARGET_EXPR_SLOT.
+Perhaps this could use WITH_CLEANUP_EXPR instead, but
+gimplify.cc doesn't ha
[gcc r15-7531] c++: remove unicode from comment
https://gcc.gnu.org/g:823de62f5f66f052193aa74520dec94fb3488958
commit r15-7531-g823de62f5f66f052193aa74520dec94fb3488958
Author: Jason Merrill
Date: Fri Feb 14 10:52:21 2025 +0100
c++: remove unicode from comment
We had a stray U+2019 right single quotation mark instead of U+0027
apostrophe.
gcc/cp/ChangeLog:
* init.cc (perform_member_init): Remove unicode from comment.
Diff:
---
gcc/cp/init.cc | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/gcc/cp/init.cc b/gcc/cp/init.cc
index 20f4408cc9a1..bc0754735549 100644
--- a/gcc/cp/init.cc
+++ b/gcc/cp/init.cc
@@ -1093,7 +1093,7 @@ perform_member_init (tree member, tree init,
hash_set &uninitialized)
{
/* With references and list-initialization, we need to deal with
extending temporary lifetimes. 12.2p5: "A temporary bound to a
-reference member in a constructor’s ctor-initializer (12.6.2)
+reference member in a constructor's ctor-initializer (12.6.2)
persists until the constructor exits." */
unsigned i; tree t;
releasing_vec cleanups;
[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] Correction ICE class_to_type_1
https://gcc.gnu.org/g:3365380377cc2a545a2d49c4b100499b569dc9c1
commit 3365380377cc2a545a2d49c4b100499b569dc9c1
Author: Mikael Morin
Date: Fri Feb 14 17:11:03 2025 +0100
Correction ICE class_to_type_1
Diff:
---
gcc/fortran/trans-array.cc | 30 --
1 file changed, 16 insertions(+), 14 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 996af4b4e7e8..ceaeeeb2a855 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -8144,22 +8144,24 @@ late_set_loop_bounds (gfc_loopinfo *loop)
for (n = 0; n < loop->dimen; n++)
{
- /* We should have found the scalarization loop specifier. If not,
-that's bad news. */
- gcc_assert (loopspec[n]);
-
- info = &loopspec[n]->info->data.array;
- dim = loopspec[n]->dim[n];
-
/* Set the extents of this range. */
- if ((loop->from[n] == NULL_TREE
- || loop->to[n] == NULL_TREE)
- && loopspec[n]->info->type == GFC_SS_FUNCTION
- && info->start[dim]
- && info->end[dim])
+ if (loop->from[n] == NULL_TREE
+ || loop->to[n] == NULL_TREE)
{
- loop->from[n] = info->start[dim];
- loop->to[n] = info->end[dim];
+ /* We should have found the scalarization loop specifier. If not,
+that's bad news. */
+ gcc_assert (loopspec[n]);
+
+ info = &loopspec[n]->info->data.array;
+ dim = loopspec[n]->dim[n];
+
+ if (loopspec[n]->info->type == GFC_SS_FUNCTION
+ && info->start[dim]
+ && info->end[dim])
+ {
+ loop->from[n] = info->start[dim];
+ loop->to[n] = info->end[dim];
+ }
}
}
[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] Sauvegarde modif
https://gcc.gnu.org/g:b0e50451cf7cc27567d93819954790ec76bb4ae8
commit b0e50451cf7cc27567d93819954790ec76bb4ae8
Author: Mikael Morin
Date: Fri Feb 14 16:55:42 2025 +0100
Sauvegarde modif
Diff:
---
gcc/fortran/trans-array.cc | 94 --
gcc/fortran/trans-expr.cc | 25 ++--
2 files changed, 85 insertions(+), 34 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index b121dc94f671..996af4b4e7e8 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -5591,18 +5591,48 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss,
bool subscript,
break;
case GFC_SS_FUNCTION:
- /* Array function return value. We call the function and save its
-result in a temporary for use inside the loop. */
- gfc_init_se (&se, NULL);
- se.loop = loop;
- se.ss = ss;
- if (gfc_is_class_array_function (expr))
- expr->must_finalize = 1;
- gfc_conv_expr (&se, expr);
- gfc_add_block_to_block (&outer_loop->pre, &se.pre);
- gfc_add_block_to_block (&outer_loop->post, &se.post);
- gfc_add_block_to_block (&outer_loop->post, &se.finalblock);
- ss_info->string_length = se.string_length;
+ {
+ /* Array function return value. We call the function and save its
+ result in a temporary for use inside the loop. */
+ gfc_init_se (&se, NULL);
+ se.loop = loop;
+ se.ss = ss;
+ bool class_func = gfc_is_class_array_function (expr);
+ if (class_func)
+ expr->must_finalize = 1;
+ gfc_conv_expr (&se, expr);
+ gfc_add_block_to_block (&outer_loop->pre, &se.pre);
+ if (class_func
+ && se.expr
+ && GFC_CLASS_TYPE_P (TREE_TYPE (se.expr)))
+ {
+ tree tmp = gfc_class_data_get (se.expr);
+ info->descriptor = tmp;
+ info->data = gfc_conv_descriptor_data_get (tmp);
+ info->offset = gfc_conv_descriptor_offset_get (tmp);
+ for (gfc_ss *s = ss; s; s = s->parent)
+ for (int n = 0; n < s->dimen; n++)
+ {
+ int dim = s->dim[n];
+ tree tree_dim = gfc_rank_cst[dim];
+
+ tree start = gfc_conv_descriptor_lbound_get (tmp,
tree_dim);
+ start = gfc_evaluate_now (start, &outer_loop->pre);
+ info->start[dim] = start;
+
+ tree end = gfc_conv_descriptor_ubound_get (tmp, tree_dim);
+ end = gfc_evaluate_now (end, &outer_loop->pre);
+ info->end[dim] = end;
+
+ tree stride = gfc_conv_descriptor_stride_get (tmp,
tree_dim);
+ stride = gfc_evaluate_now (stride, &outer_loop->pre);
+ info->stride[dim] = stride;
+ }
+ }
+ gfc_add_block_to_block (&outer_loop->post, &se.post);
+ gfc_add_block_to_block (&outer_loop->post, &se.finalblock);
+ ss_info->string_length = se.string_length;
+ }
break;
case GFC_SS_CONSTRUCTOR:
@@ -8100,6 +8130,44 @@ set_loop_bounds (gfc_loopinfo *loop)
}
+/* Last attempt to set the loop bounds, in case they depend on an allocatable
+ function result. */
+
+static void
+late_set_loop_bounds (gfc_loopinfo *loop)
+{
+ int n, dim;
+ gfc_array_info *info;
+ gfc_ss **loopspec;
+
+ loopspec = loop->specloop;
+
+ for (n = 0; n < loop->dimen; n++)
+{
+ /* We should have found the scalarization loop specifier. If not,
+that's bad news. */
+ gcc_assert (loopspec[n]);
+
+ info = &loopspec[n]->info->data.array;
+ dim = loopspec[n]->dim[n];
+
+ /* Set the extents of this range. */
+ if ((loop->from[n] == NULL_TREE
+ || loop->to[n] == NULL_TREE)
+ && loopspec[n]->info->type == GFC_SS_FUNCTION
+ && info->start[dim]
+ && info->end[dim])
+ {
+ loop->from[n] = info->start[dim];
+ loop->to[n] = info->end[dim];
+ }
+}
+
+ for (loop = loop->nested; loop; loop = loop->next)
+set_loop_bounds (loop);
+}
+
+
/* Initialize the scalarization loop. Creates the loop variables. Determines
the range of the loop variables. Creates a temporary if required.
Also generates code for scalar expressions which have been
@@ -8118,6 +8186,8 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where)
allocating the temporary. */
gfc_add_loop_ss_code (loop, loop->ss, false, where);
+ late_set_loop_bounds (loop);
+
tmp_ss = loop->temp_ss;
/* If we want a temporary then create it. */
if (tmp_ss != NULL)
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 44a09f546aa6..bbf187f9b7bb 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran
[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] Correction régression class_to_type_2.f90
https://gcc.gnu.org/g:2342ea2cdae3cd3aad4ba66521da98616079de4e commit 2342ea2cdae3cd3aad4ba66521da98616079de4e Author: Mikael Morin Date: Fri Feb 14 17:23:47 2025 +0100 Correction régression class_to_type_2.f90 Diff: --- gcc/fortran/trans-array.cc | 8 +--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc index ceaeeeb2a855..4120785b49b5 100644 --- a/gcc/fortran/trans-array.cc +++ b/gcc/fortran/trans-array.cc @@ -8246,9 +8246,11 @@ gfc_set_delta (gfc_loopinfo *loop) gfc_ss_type ss_type; ss_type = ss->info->type; - if (ss_type != GFC_SS_SECTION - && ss_type != GFC_SS_COMPONENT - && ss_type != GFC_SS_CONSTRUCTOR) + if (!(ss_type == GFC_SS_SECTION + || ss_type == GFC_SS_COMPONENT + || ss_type == GFC_SS_CONSTRUCTOR + || (ss_type == GFC_SS_FUNCTION + && gfc_is_class_array_function (ss->info->expr continue; info = &ss->info->data.array;
