[gcc r15-10173] c++: substituting fn parm redeclared with dep alias tmpl [PR120224]
https://gcc.gnu.org/g:121235441d072c2f5fd4d2cc0c342d45d6ac481f
commit r15-10173-g121235441d072c2f5fd4d2cc0c342d45d6ac481f
Author: Patrick Palka
Date: Thu Jun 5 11:07:25 2025 -0400
c++: substituting fn parm redeclared with dep alias tmpl [PR120224]
Here we declare f twice, the second time around using a dependent
alias template. Due to alias template transparency these are logically
the same overload. But now the function type of f (produced from the
first declaration) diverges from the type of its formal parameter
(produced from the subsequent redefinition) in that substituting T=int
succeeds for the function type but not for the formal parameter type.
This eventually causes us to produce an undiagnosed error_mark_node in
the AST of the function call, leading to failure of the sanity check
check added in r14-6343-g0c018a74eb1aff.
Before r14-6343 we would still go on to reject the testcase later at
instantiation time, from regenerate_decl_from_template, making this a
regression.
To fix this, it seems we just need to propagate error_mark_node upon
substitution failure into the type of a PARM_DECL.
PR c++/120224
gcc/cp/ChangeLog:
* pt.cc (tsubst_function_decl): Return error_mark_node if
substituting into the formal parameter list failed.
(tsubst_decl) : Return error_mark_node
upon TREE_TYPE substitution failure, when in a SFINAE
context. Return error_mark_node upon DECL_CHAIN substitution
failure.
gcc/testsuite/ChangeLog:
* g++.dg/cpp0x/alias-decl-80.C: New test.
Reviewed-by: Jason Merrill
(cherry picked from commit 51e93aadc94940e2da854cf1321a7ab1aebf8d1a)
Diff:
---
gcc/cp/pt.cc | 14 --
gcc/testsuite/g++.dg/cpp0x/alias-decl-80.C | 21 +
2 files changed, 33 insertions(+), 2 deletions(-)
diff --git a/gcc/cp/pt.cc b/gcc/cp/pt.cc
index 8b7dc5cb2235..aa19455e3213 100644
--- a/gcc/cp/pt.cc
+++ b/gcc/cp/pt.cc
@@ -14906,6 +14906,8 @@ tsubst_function_decl (tree t, tree args, tsubst_flags_t
complain,
if (closure && DECL_IOBJ_MEMBER_FUNCTION_P (t))
parms = DECL_CHAIN (parms);
parms = tsubst (parms, args, complain, t);
+ if (parms == error_mark_node)
+return error_mark_node;
for (tree parm = parms; parm; parm = DECL_CHAIN (parm))
DECL_CONTEXT (parm) = r;
if (closure && DECL_IOBJ_MEMBER_FUNCTION_P (t))
@@ -15478,6 +15480,9 @@ tsubst_decl (tree t, tree args, tsubst_flags_t complain,
/* We're dealing with a normal parameter. */
type = tsubst (TREE_TYPE (t), args, complain, in_decl);
+ if (type == error_mark_node && !(complain & tf_error))
+ RETURN (error_mark_node);
+
type = type_decays_to (type);
TREE_TYPE (r) = type;
cp_apply_type_quals_to_decl (cp_type_quals (type), r);
@@ -15515,8 +15520,13 @@ tsubst_decl (tree t, tree args, tsubst_flags_t
complain,
/* If cp_unevaluated_operand is set, we're just looking for a
single dummy parameter, so don't keep going. */
if (DECL_CHAIN (t) && !cp_unevaluated_operand)
- DECL_CHAIN (r) = tsubst (DECL_CHAIN (t), args,
- complain, DECL_CHAIN (t));
+ {
+ tree chain = tsubst (DECL_CHAIN (t), args,
+complain, DECL_CHAIN (t));
+ if (chain == error_mark_node)
+ RETURN (error_mark_node);
+ DECL_CHAIN (r) = chain;
+ }
/* FIRST_R contains the start of the chain we've built. */
r = first_r;
diff --git a/gcc/testsuite/g++.dg/cpp0x/alias-decl-80.C
b/gcc/testsuite/g++.dg/cpp0x/alias-decl-80.C
new file mode 100644
index ..9c0eadc967c0
--- /dev/null
+++ b/gcc/testsuite/g++.dg/cpp0x/alias-decl-80.C
@@ -0,0 +1,21 @@
+// PR c++/120224
+// { dg-do compile { target c++11 } }
+
+template using void_t = void;
+
+template
+void f(void*); // #1
+
+template
+void f(void_t*) { } // { dg-error "not a class" } defn of #1
+
+template
+void g(int, void*); // #2
+
+template
+void g(int, void_t*) { } // { dg-error "not a class" } defn
of #2
+
+int main() {
+ f(0); // { dg-error "no match" }
+ g(0, 0); // { dg-error "no match" }
+}
[gcc r15-10175] aarch64: Prevent streaming-compatible code from assembler rejection [PR121028]
https://gcc.gnu.org/g:b3da1801bef08c75f69f4376ffa05f1de2591ca8
commit r15-10175-gb3da1801bef08c75f69f4376ffa05f1de2591ca8
Author: Spencer Abson
Date: Thu Jul 31 14:07:31 2025 +
aarch64: Prevent streaming-compatible code from assembler rejection
[PR121028]
Streaming-compatible functions can be compiled without SME enabled, but need
to use "SMSTART SM" and "SMSTOP SM" to temporarily switch into the streaming
state of a callee. These switches are conditional on the current mode being
opposite to the target mode, so no SME instructions are executed if SME is
not
available.
However, in GAS, "SMSTART SM" and "SMSTOP SM" always require +sme. A call
from a streaming-compatible function, compiled without SME enabled, to a non
-streaming function will be rejected as:
Error: selected processor does not support `smstop sm'..
To work around this, we make use of the .inst directive to insert the
literal
encodings of "SMSTART SM" and "SMSTOP SM".
gcc/ChangeLog:
PR target/121028
* config/aarch64/aarch64-sme.md (aarch64_smstart_sm): Use the .inst
directive if !TARGET_SME.
(aarch64_smstop_sm): Likewise.
gcc/testsuite/ChangeLog:
PR target/121028
* gcc.target/aarch64/sme/call_sm_switch_1.c: Tell check-function
-bodies not to ignore .inst directives, and replace the test for
"smstart sm" with one for it's encoding.
* gcc.target/aarch64/sme/call_sm_switch_11.c: Likewise.
* gcc.target/aarch64/sme/pr121028.c: New test.
(cherry picked from commit d52e9ef98bb30872482a46e7a2ec6a20c3ca4a4c)
Diff:
---
gcc/config/aarch64/aarch64-sme.md | 12 +-
.../gcc.target/aarch64/sme/call_sm_switch_1.c | 4 +-
.../gcc.target/aarch64/sme/call_sm_switch_11.c | 5 ++-
gcc/testsuite/gcc.target/aarch64/sme/pr121028.c| 46 ++
4 files changed, 61 insertions(+), 6 deletions(-)
diff --git a/gcc/config/aarch64/aarch64-sme.md
b/gcc/config/aarch64/aarch64-sme.md
index f7958c90eae4..3673941ab869 100644
--- a/gcc/config/aarch64/aarch64-sme.md
+++ b/gcc/config/aarch64/aarch64-sme.md
@@ -61,6 +61,10 @@
;; (b) they are sometimes used conditionally, particularly in streaming-
;; compatible code.
;;
+;; To prevent the latter from upsetting the assembler, we emit the literal
+;; encodings of "SMSTART SM" and "SMSTOP SM" when compiling without
+;; TARGET_SME.
+;;
;; =
;; -
@@ -160,7 +164,9 @@
(clobber (reg:VNx16BI P14_REGNUM))
(clobber (reg:VNx16BI P15_REGNUM))]
""
- "smstart\tsm"
+ {
+return TARGET_SME ? "smstart\tsm" : ".inst 0xd503437f // smstart sm";
+ }
)
;; Turn off streaming mode. This clobbers all SVE state.
@@ -195,7 +201,9 @@
(clobber (reg:VNx16BI P14_REGNUM))
(clobber (reg:VNx16BI P15_REGNUM))]
""
- "smstop\tsm"
+ {
+return TARGET_SME ? "smstop\tsm" : ".inst 0xd503427f // smstop sm";
+ }
)
;; -
diff --git a/gcc/testsuite/gcc.target/aarch64/sme/call_sm_switch_1.c
b/gcc/testsuite/gcc.target/aarch64/sme/call_sm_switch_1.c
index 98922aaeae09..3a63da7439cc 100644
--- a/gcc/testsuite/gcc.target/aarch64/sme/call_sm_switch_1.c
+++ b/gcc/testsuite/gcc.target/aarch64/sme/call_sm_switch_1.c
@@ -1,5 +1,5 @@
// { dg-options "-O -fomit-frame-pointer -fno-optimize-sibling-calls
-funwind-tables" }
-// { dg-final { check-function-bodies "**" "" } }
+// { dg-final { check-function-bodies "**" "" "" { target "*-*-*" } {\t\.inst}
} }
void ns_callee ();
void s_callee () [[arm::streaming]];
@@ -218,7 +218,7 @@ sc_caller_x1 (int *ptr, int a) [[arm::streaming_compatible]]
** bl ns_callee_stack
** ldr x16, \[x29, #?16\]
** tbz x16, 0, .*
-** smstart sm
+** .inst 0xd503437f // smstart sm
** ...
*/
void
diff --git a/gcc/testsuite/gcc.target/aarch64/sme/call_sm_switch_11.c
b/gcc/testsuite/gcc.target/aarch64/sme/call_sm_switch_11.c
index ee6f98737d96..c72d03f33b97 100644
--- a/gcc/testsuite/gcc.target/aarch64/sme/call_sm_switch_11.c
+++ b/gcc/testsuite/gcc.target/aarch64/sme/call_sm_switch_11.c
@@ -1,5 +1,6 @@
// { dg-options "-O -fomit-frame-pointer -fno-optimize-sibling-calls
-funwind-tables -mtrack-speculation" }
-// { dg-final { check-function-bodies "**" "" } }
+// { dg-final { check-function-bodies "**" "" "" { target "*-*-*" } {\t\.inst}
} }
+
void ns_callee ();
void s_callee () [[arm::streaming]];
@@ -196,7 +197,7 @@ sc_caller_x1 (int *ptr, int a) [[arm::streaming_compatible]]
** tst x16, #?1
** beq [^\n]*
** cselx15, x15, xzr, ne
-** smstart sm
+** .inst 0xd503437f // smstart sm
** ...
*/
void
diff --git a/gcc/testsuite/gcc.target
[gcc r16-2683] libgcc: Cleanup HWCAP defines in cpuinfo.c
https://gcc.gnu.org/g:a6bb6934a491015c4d3f08763455d86ccfb3bcbe
commit r16-2683-ga6bb6934a491015c4d3f08763455d86ccfb3bcbe
Author: Wilco Dijkstra
Date: Mon Apr 28 16:20:15 2025 +
libgcc: Cleanup HWCAP defines in cpuinfo.c
Cleanup HWCAP defines - rather than including hwcap.h and then repeating it
using ifndef, just define the HWCAPs we need exactly as in hwcap.h.
libgcc:
* config/aarch64/cpuinfo.c: Cleanup HWCAP defines.
Diff:
---
libgcc/config/aarch64/cpuinfo.c | 246
1 file changed, 49 insertions(+), 197 deletions(-)
diff --git a/libgcc/config/aarch64/cpuinfo.c b/libgcc/config/aarch64/cpuinfo.c
index 50f54cac26b4..3ce37029b16c 100644
--- a/libgcc/config/aarch64/cpuinfo.c
+++ b/libgcc/config/aarch64/cpuinfo.c
@@ -40,213 +40,66 @@ typedef struct __ifunc_arg_t {
unsigned long _hwcap4;
} __ifunc_arg_t;
-#if __has_include()
-#include
-
/* Architecture features used in Function Multi Versioning. */
struct {
unsigned long long features;
/* As features grows new fields could be added. */
} __aarch64_cpu_features __attribute__((visibility("hidden"), nocommon));
-#ifndef _IFUNC_ARG_HWCAP
#define _IFUNC_ARG_HWCAP (1ULL << 62)
-#endif
-#ifndef AT_HWCAP
#define AT_HWCAP 16
-#endif
-#ifndef HWCAP_FP
-#define HWCAP_FP (1 << 0)
-#endif
-#ifndef HWCAP_ASIMD
-#define HWCAP_ASIMD (1 << 1)
-#endif
-#ifndef HWCAP_EVTSTRM
-#define HWCAP_EVTSTRM (1 << 2)
-#endif
-#ifndef HWCAP_AES
-#define HWCAP_AES (1 << 3)
-#endif
-#ifndef HWCAP_PMULL
-#define HWCAP_PMULL (1 << 4)
-#endif
-#ifndef HWCAP_SHA1
-#define HWCAP_SHA1 (1 << 5)
-#endif
-#ifndef HWCAP_SHA2
-#define HWCAP_SHA2 (1 << 6)
-#endif
-#ifndef HWCAP_CRC32
-#define HWCAP_CRC32 (1 << 7)
-#endif
-#ifndef HWCAP_ATOMICS
-#define HWCAP_ATOMICS (1 << 8)
-#endif
-#ifndef HWCAP_FPHP
-#define HWCAP_FPHP (1 << 9)
-#endif
-#ifndef HWCAP_ASIMDHP
-#define HWCAP_ASIMDHP (1 << 10)
-#endif
-#ifndef HWCAP_CPUID
-#define HWCAP_CPUID (1 << 11)
-#endif
-#ifndef HWCAP_ASIMDRDM
-#define HWCAP_ASIMDRDM (1 << 12)
-#endif
-#ifndef HWCAP_JSCVT
-#define HWCAP_JSCVT (1 << 13)
-#endif
-#ifndef HWCAP_FCMA
-#define HWCAP_FCMA (1 << 14)
-#endif
-#ifndef HWCAP_LRCPC
-#define HWCAP_LRCPC (1 << 15)
-#endif
-#ifndef HWCAP_DCPOP
-#define HWCAP_DCPOP (1 << 16)
-#endif
-#ifndef HWCAP_SHA3
-#define HWCAP_SHA3 (1 << 17)
-#endif
-#ifndef HWCAP_SM3
-#define HWCAP_SM3 (1 << 18)
-#endif
-#ifndef HWCAP_SM4
-#define HWCAP_SM4 (1 << 19)
-#endif
-#ifndef HWCAP_ASIMDDP
-#define HWCAP_ASIMDDP (1 << 20)
-#endif
-#ifndef HWCAP_SHA512
-#define HWCAP_SHA512 (1 << 21)
-#endif
-#ifndef HWCAP_SVE
-#define HWCAP_SVE (1 << 22)
-#endif
-#ifndef HWCAP_ASIMDFHM
-#define HWCAP_ASIMDFHM (1 << 23)
-#endif
-#ifndef HWCAP_DIT
-#define HWCAP_DIT (1 << 24)
-#endif
-#ifndef HWCAP_ILRCPC
-#define HWCAP_ILRCPC (1 << 26)
-#endif
-#ifndef HWCAP_FLAGM
-#define HWCAP_FLAGM (1 << 27)
-#endif
-#ifndef HWCAP_SSBS
-#define HWCAP_SSBS (1 << 28)
-#endif
-#ifndef HWCAP_SB
-#define HWCAP_SB (1 << 29)
-#endif
-#ifndef HWCAP_PACA
-#define HWCAP_PACA (1 << 30)
-#endif
-#ifndef HWCAP_PACG
-#define HWCAP_PACG (1UL << 31)
-#endif
-
-#ifndef AT_HWCAP2
#define AT_HWCAP2 26
-#endif
-#ifndef HWCAP2_DCPODP
-#define HWCAP2_DCPODP (1 << 0)
-#endif
-#ifndef HWCAP2_SVE2
-#define HWCAP2_SVE2 (1 << 1)
-#endif
-#ifndef HWCAP2_SVEAES
-#define HWCAP2_SVEAES (1 << 2)
-#endif
-#ifndef HWCAP2_SVEPMULL
-#define HWCAP2_SVEPMULL (1 << 3)
-#endif
-#ifndef HWCAP2_SVEBITPERM
-#define HWCAP2_SVEBITPERM (1 << 4)
-#endif
-#ifndef HWCAP2_SVESHA3
-#define HWCAP2_SVESHA3 (1 << 5)
-#endif
-#ifndef HWCAP2_SVESM4
-#define HWCAP2_SVESM4 (1 << 6)
-#endif
-#ifndef HWCAP2_FLAGM2
-#define HWCAP2_FLAGM2 (1 << 7)
-#endif
-#ifndef HWCAP2_FRINT
-#define HWCAP2_FRINT (1 << 8)
-#endif
-#ifndef HWCAP2_SVEI8MM
-#define HWCAP2_SVEI8MM (1 << 9)
-#endif
-#ifndef HWCAP2_SVEF32MM
-#define HWCAP2_SVEF32MM (1 << 10)
-#endif
-#ifndef HWCAP2_SVEF64MM
-#define HWCAP2_SVEF64MM (1 << 11)
-#endif
-#ifndef HWCAP2_SVEBF16
-#define HWCAP2_SVEBF16 (1 << 12)
-#endif
-#ifndef HWCAP2_I8MM
-#define HWCAP2_I8MM (1 << 13)
-#endif
-#ifndef HWCAP2_BF16
-#define HWCAP2_BF16 (1 << 14)
-#endif
-#ifndef HWCAP2_DGH
-#define HWCAP2_DGH (1 << 15)
-#endif
-#ifndef HWCAP2_RNG
-#define HWCAP2_RNG (1 << 16)
-#endif
-#ifndef HWCAP2_BTI
-#define HWCAP2_BTI (1 << 17)
-#endif
-#ifndef HWCAP2_MTE
-#define HWCAP2_MTE (1 << 18)
-#endif
-#ifndef HWCAP2_RPRES
-#define HWCAP2_RPRES (1 << 21)
-#endif
-#ifndef HWCAP2_MTE3
-#define HWCAP2_MTE3 (1 << 22)
-#endif
-#ifndef HWCAP2_SME
-#define HWCAP2_SME (1 << 23)
-#endif
-#ifndef HWCAP2_SME_I16I64
-#define HWCAP2_SME_I16I64 (1 << 24)
-#endif
-#ifndef HWCAP2_SME_F64F64
-#define HWCAP2_SME_F64F64 (1 << 25)
-#endif
-#ifndef HWCAP2_WFXT
-#define HWCAP2_WFXT (1UL << 31)
-#endif
-#ifndef HWCAP2_EBF16
-#define HWCAP2_EBF16 (1UL << 32)
-#endif
-#ifndef HWCAP2_SVE_EBF16
-#define HWCAP2_SVE_EBF16 (1UL << 33)
-#endif
-#ifndef HWCAP2_SME2
-#define HWCAP2_SME2 (1UL << 37)
-#endif
-#ifndef HWCAP2_LRCPC3
-#define HW
[gcc r16-2684] libgcc: Update FMV features to latest ACLE spec 2024Q4
https://gcc.gnu.org/g:9996036205b5a71e7738f2daa29f4e6f79886a4e
commit r16-2684-g9996036205b5a71e7738f2daa29f4e6f79886a4e
Author: Wilco Dijkstra
Date: Tue Mar 25 15:51:42 2025 +
libgcc: Update FMV features to latest ACLE spec 2024Q4
Update FMV features to latest ACLE spec of 2024Q4 - several features have
been
removed or merged. Add FMV support for CSSC and MOPS. Preserve the
ordering
in enum CPUFeatures.
gcc:
* common/config/aarch64/cpuinfo.h: Remove unused features, add
FEAT_CSSC
and FEAT_MOPS.
* config/aarch64/aarch64-option-extensions.def: Remove FMV support
for RPRES, use PULL rather than AES, add FMV support for CSSC and
MOPS.
libgcc:
* config/aarch64/cpuinfo.c (__init_cpu_features_constructor):
Remove unused features, add support for CSSC and MOPS.
Diff:
---
gcc/common/config/aarch64/cpuinfo.h | 25 -
gcc/config/aarch64/aarch64-option-extensions.def | 12 -
libgcc/config/aarch64/cpuinfo.c | 34 +---
3 files changed, 25 insertions(+), 46 deletions(-)
diff --git a/gcc/common/config/aarch64/cpuinfo.h
b/gcc/common/config/aarch64/cpuinfo.h
index cd3c2b20c531..d329d861bf73 100644
--- a/gcc/common/config/aarch64/cpuinfo.h
+++ b/gcc/common/config/aarch64/cpuinfo.h
@@ -39,10 +39,10 @@ enum CPUFeatures {
FEAT_FP,
FEAT_SIMD,
FEAT_CRC,
- FEAT_SHA1,
+ FEAT_CSSC,
FEAT_SHA2,
FEAT_SHA3,
- FEAT_AES,
+ FEAT_unused5,
FEAT_PMULL,
FEAT_FP16,
FEAT_DIT,
@@ -53,30 +53,30 @@ enum CPUFeatures {
FEAT_RCPC,
FEAT_RCPC2,
FEAT_FRINTTS,
- FEAT_DGH,
+ FEAT_unused6,
FEAT_I8MM,
FEAT_BF16,
- FEAT_EBF16,
- FEAT_RPRES,
+ FEAT_unused7,
+ FEAT_unused8,
FEAT_SVE,
- FEAT_SVE_BF16,
- FEAT_SVE_EBF16,
- FEAT_SVE_I8MM,
+ FEAT_unused9,
+ FEAT_unused10,
+ FEAT_unused11,
FEAT_SVE_F32MM,
FEAT_SVE_F64MM,
FEAT_SVE2,
- FEAT_SVE_AES,
+ FEAT_unused12,
FEAT_SVE_PMULL128,
FEAT_SVE_BITPERM,
FEAT_SVE_SHA3,
FEAT_SVE_SM4,
FEAT_SME,
- FEAT_MEMTAG,
+ FEAT_unused13,
FEAT_MEMTAG2,
- FEAT_MEMTAG3,
+ FEAT_unused14,
FEAT_SB,
FEAT_unused1,
- FEAT_SSBS,
+ FEAT_unused15,
FEAT_SSBS2,
FEAT_BTI,
FEAT_unused2,
@@ -87,6 +87,7 @@ enum CPUFeatures {
FEAT_SME_I64,
FEAT_SME2,
FEAT_RCPC3,
+ FEAT_MOPS,
FEAT_MAX,
FEAT_EXT = 62, /* Reserved to indicate presence of additional features field
in __aarch64_cpu_features. */
diff --git a/gcc/config/aarch64/aarch64-option-extensions.def
b/gcc/config/aarch64/aarch64-option-extensions.def
index 1c3e69799f5a..db88df08a6af 100644
--- a/gcc/config/aarch64/aarch64-option-extensions.def
+++ b/gcc/config/aarch64/aarch64-option-extensions.def
@@ -128,7 +128,9 @@ AARCH64_OPT_FMV_EXTENSION("sha2", SHA2, (SIMD), (), (),
"sha1 sha2")
AARCH64_FMV_FEATURE("sha3", SHA3, (SHA3))
-AARCH64_OPT_FMV_EXTENSION("aes", AES, (SIMD), (), (), "aes")
+AARCH64_OPT_EXTENSION("aes", AES, (SIMD), (), (), "aes")
+
+AARCH64_FMV_FEATURE("aes", PMULL, (AES))
/* +nocrypto disables AES, SHA2 and SM4, and anything that depends on them
(such as SHA3 and the SVE2 crypto extensions). */
@@ -171,8 +173,6 @@ AARCH64_OPT_FMV_EXTENSION("i8mm", I8MM, (SIMD), (), (),
"i8mm")
instructions. */
AARCH64_OPT_FMV_EXTENSION("bf16", BF16, (FP), (SIMD), (), "bf16")
-AARCH64_FMV_FEATURE("rpres", RPRES, ())
-
AARCH64_OPT_FMV_EXTENSION("sve", SVE, (SIMD, F16, FCMA), (), (), "sve")
/* This specifically does not imply +sve. */
@@ -190,7 +190,7 @@ AARCH64_OPT_FMV_EXTENSION("sve2", SVE2, (SVE), (), (),
"sve2")
AARCH64_OPT_EXTENSION("sve2-aes", SVE2_AES, (SVE2, AES), (), (), "sveaes")
-AARCH64_FMV_FEATURE("sve2-aes", SVE_AES, (SVE2_AES))
+AARCH64_FMV_FEATURE("sve2-aes", SVE_PMULL128, (SVE2_AES))
AARCH64_OPT_EXTENSION("sve2-bitperm", SVE2_BITPERM, (SVE2), (), (),
"svebitperm")
@@ -245,9 +245,9 @@ AARCH64_OPT_EXTENSION("sme-b16b16", SME_B16B16, (SME2,
SVE_B16B16), (), (), "sme
AARCH64_OPT_EXTENSION("sme-f16f16", SME_F16F16, (SME2), (), (), "smef16f16")
-AARCH64_OPT_EXTENSION("mops", MOPS, (), (), (), "mops")
+AARCH64_OPT_FMV_EXTENSION("mops", MOPS, (), (), (), "mops")
-AARCH64_OPT_EXTENSION("cssc", CSSC, (), (), (), "cssc")
+AARCH64_OPT_FMV_EXTENSION("cssc", CSSC, (), (), (), "cssc")
AARCH64_OPT_EXTENSION("cmpbr", CMPBR, (), (), (), "cmpbr")
diff --git a/libgcc/config/aarch64/cpuinfo.c b/libgcc/config/aarch64/cpuinfo.c
index 3ce37029b16c..f8c10037bb31 100644
--- a/libgcc/config/aarch64/cpuinfo.c
+++ b/libgcc/config/aarch64/cpuinfo.c
@@ -143,10 +143,6 @@ __init_cpu_features_constructor (unsigned long hwcap,
setCPUFeature(FEAT_DIT);
if (hwcap & HWCAP_ASIMDRDM)
setCPUFeature(FEAT_RDM);
- if (hwcap & HWCAP_AES)
-setCPUFeature(FEAT_AES);
- if (hwcap & HWCAP_SHA1)
-setCPUFeature(FEAT_SHA1);
if (hwcap & HWCAP_SHA2)
setCPUFeature(FEAT_SHA2);
if (hwcap & HWCAP_JSCVT)
[gcc r16-2682] AArch64: Use correct cost for shifted halfword load/stores
https://gcc.gnu.org/g:731649066f0fd2e2b2fbfd8668e001c3e91290d6
commit r16-2682-g731649066f0fd2e2b2fbfd8668e001c3e91290d6
Author: Wilco Dijkstra
Date: Thu Jun 26 15:41:06 2025 +
AArch64: Use correct cost for shifted halfword load/stores
Since all Armv9 cores support shifted LDRH/STRH, use the correct cost of
zero
for these.
gcc:
* config/aarch64/tuning_models/generic_armv9_a.h
(generic_armv9_a_addrcost_table): Use zero cost for himode.
Diff:
---
gcc/config/aarch64/tuning_models/generic_armv9_a.h | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/gcc/config/aarch64/tuning_models/generic_armv9_a.h
b/gcc/config/aarch64/tuning_models/generic_armv9_a.h
index f76a2506f384..9eb1a20d3c4e 100644
--- a/gcc/config/aarch64/tuning_models/generic_armv9_a.h
+++ b/gcc/config/aarch64/tuning_models/generic_armv9_a.h
@@ -26,7 +26,7 @@
static const struct cpu_addrcost_table generic_armv9_a_addrcost_table =
{
{
- 1, /* hi */
+ 0, /* hi */
0, /* si */
0, /* di */
1, /* ti */
[gcc r15-10174] aarch64: testsuite: Fix do-assemble tests for SME
https://gcc.gnu.org/g:9e84a4552dd90ad2d15bd56ea168d945b4b71b98
commit r15-10174-g9e84a4552dd90ad2d15bd56ea168d945b4b71b98
Author: Spencer Abson
Date: Thu Jul 31 13:53:08 2025 +
aarch64: testsuite: Fix do-assemble tests for SME
GCC doesn't support SME without SVE2, so the -march=armv8-a+ argument
to
check_no_compiler_messages causes aarch64_asm__ok to return zero for
SME
and any that implies it.
This patch changes the baseline architecure to armv9-a for these extensions.
gcc/testsuite/ChangeLog:
* lib/target-supports.exp: Split the extensions that require SME
into
a separate set, and use armv9-a as their baseline.
(cherry picked from commit 9793ffce9332349441b5c83f8c1809ac4264a0f2)
Diff:
---
gcc/testsuite/lib/target-supports.exp | 34 --
1 file changed, 28 insertions(+), 6 deletions(-)
diff --git a/gcc/testsuite/lib/target-supports.exp
b/gcc/testsuite/lib/target-supports.exp
index 35dca396f4ef..c0376b04551e 100644
--- a/gcc/testsuite/lib/target-supports.exp
+++ b/gcc/testsuite/lib/target-supports.exp
@@ -12367,12 +12367,20 @@ proc check_effective_target_aarch64_tiny { } {
# Create functions to check that the AArch64 assembler supports the
# various architecture extensions via the .arch_extension pseudo-op.
-foreach { aarch64_ext } { "fp" "simd" "crypto" "crc" "lse" "dotprod" "sve"
- "i8mm" "f32mm" "f64mm" "bf16" "sb" "sve2" "ls64"
- "lut" "sme" "sme-i16i64" "sme2" "sve-b16b16"
- "sme-b16b16" "sme-f16f16" "sme2p1" "fp8" "fp8fma"
- "ssve-fp8fma" "fp8dot2" "ssve-fp8dot2" "fp8dot4"
- "ssve-fp8dot4"} {
+set exts {
+"bf16" "crc" "crypto" "dotprod" "f32mm" "f64mm" "fp" "fp8"
+"fp8dot2" "fp8dot4" "fp8fma" "i8mm" "ls64" "lse" "lut" "sb" "simd"
+"sve-b16b16" "sve" "sve2"
+}
+
+# We don't support SME without SVE2, so we'll use armv9 as the base
+# archiecture for SME and the features that require it.
+set exts_sve2 {
+"sme-b16b16" "sme-f16f16" "sme-i16i64" "sme" "sme2" "sme2p1"
+"ssve-fp8dot2" "ssve-fp8dot4" "ssve-fp8fma"
+}
+
+foreach { aarch64_ext } $exts {
eval [string map [list FUNC $aarch64_ext] {
proc check_effective_target_aarch64_asm_FUNC_ok { } {
if { [istarget aarch64*-*-*] } {
@@ -12386,6 +12394,20 @@ foreach { aarch64_ext } { "fp" "simd" "crypto" "crc"
"lse" "dotprod" "sve"
}]
}
+foreach { aarch64_ext } $exts_sve2 {
+eval [string map [list FUNC $aarch64_ext] {
+ proc check_effective_target_aarch64_asm_FUNC_ok { } {
+ if { [istarget aarch64*-*-*] } {
+ return [check_no_compiler_messages aarch64_FUNC_assembler
object {
+ __asm__ (".arch_extension FUNC");
+ } "-march=armv9-a+FUNC"]
+ } else {
+ return 0
+ }
+ }
+}]
+}
+
proc check_effective_target_aarch64_asm_sve2p1_ok { } {
if { [istarget aarch64*-*-*] } {
return [check_no_compiler_messages aarch64_sve2p1_assembler object {
[gcc r16-2685] vect: Don't set bogus bounds on epilogues [PR120805]
https://gcc.gnu.org/g:4a65ae52bacade00989f9840aab5ae11c4ef19f9
commit r16-2685-g4a65ae52bacade00989f9840aab5ae11c4ef19f9
Author: Tamar Christina
Date: Thu Jul 31 15:29:30 2025 +0100
vect: Don't set bogus bounds on epilogues [PR120805]
The testcases in the PR are failing due to the code trying to set a vector
range
on an epilogue.
However on epilogues the range doesn't make sense. In particular we are
setting
ranged to help niters analysis. But the epilogue doesn't iterate.
Secondly the bounds variable hasn't been adjusted to vector iterations:
In the epilogue this is calculated as
[local count: 81467476]:
# i_127 = PHI
# _132 = PHI <_133(10), 0(5)>
_181 = (unsigned int) n_41(D);
bnd.31_180 = _181 - _132;
where
_133 = niters_vector_mult_vf.6_130;
but _132 is a phi node, and if coming from the vector loop skip edge
_181 will be <1, VF>.
But this is a range VRP or Ranger can easily report due to the guard on the
skip_vector loop.
Previously, non-const VF would skip this code entirely due to the
.is_constant()
check.
Non-partial vector loop would also skip it because the bounds would fold to
a
constant. so it doesn't enter the !gimple_value check.
When support for partial vector ranges was added, this accidentally enabled
ranges on partial vector epilogues.
This patch now makes it explicit that ranges shouldn't be set for
epilogues, as
they don't seem to be useful anyway.
gcc/ChangeLog:
PR tree-optimization/120805
* tree-vect-loop-manip.cc (vect_gen_vector_loop_niters): Skip
setting
bounds on epilogues.
Diff:
---
gcc/tree-vect-loop-manip.cc | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/gcc/tree-vect-loop-manip.cc b/gcc/tree-vect-loop-manip.cc
index 7fcbc1ad2eb8..6c1b26adda3b 100644
--- a/gcc/tree-vect-loop-manip.cc
+++ b/gcc/tree-vect-loop-manip.cc
@@ -2857,7 +2857,7 @@ vect_gen_vector_loop_niters (loop_vec_info loop_vinfo,
tree niters,
we set range information to make niters analyzer's life easier.
Note the number of latch iteration value can be TYPE_MAX_VALUE so
we have to represent the vector niter TYPE_MAX_VALUE + 1 / vf. */
- if (stmts != NULL && const_vf > 0)
+ if (stmts != NULL && const_vf > 0 && !LOOP_VINFO_EPILOGUE_P (loop_vinfo))
{
if (niters_no_overflow
&& LOOP_VINFO_USING_PARTIAL_VECTORS_P (loop_vinfo))
[gcc r16-2686] RISC-V: Add testcases for signed avg ceil vx combine
https://gcc.gnu.org/g:9c63518f3a6a6b8c517e147db30fd47b3e371175
commit r16-2686-g9c63518f3a6a6b8c517e147db30fd47b3e371175
Author: Pan Li
Date: Wed Jul 30 14:21:02 2025 +0800
RISC-V: Add testcases for signed avg ceil vx combine
The unsigned avg ceil share the vaaddx.vx for the vx combine,
so add the test case to make sure it works well as expected.
The below test suites are passed for this patch series.
* The rv64gcv fully regression test.
gcc/testsuite/ChangeLog:
* gcc.target/riscv/rvv/autovec/vx_vf/vx-1-i16.c: Add asm check
for signed avg ceil.
* gcc.target/riscv/rvv/autovec/vx_vf/vx-1-i32.c: Ditto.
* gcc.target/riscv/rvv/autovec/vx_vf/vx-1-i64.c: Ditto.
* gcc.target/riscv/rvv/autovec/vx_vf/vx-1-i8.c: Ditto.
* gcc.target/riscv/rvv/autovec/vx_vf/vx-4-i16.c: Ditto.
* gcc.target/riscv/rvv/autovec/vx_vf/vx-4-i32.c: Ditto.
* gcc.target/riscv/rvv/autovec/vx_vf/vx-4-i64.c: Ditto.
* gcc.target/riscv/rvv/autovec/vx_vf/vx-4-i8.c: Ditto.
* gcc.target/riscv/rvv/autovec/vx_vf/vx-5-i16.c: Ditto.
* gcc.target/riscv/rvv/autovec/vx_vf/vx-5-i32.c: Ditto.
* gcc.target/riscv/rvv/autovec/vx_vf/vx-5-i64.c: Ditto.
* gcc.target/riscv/rvv/autovec/vx_vf/vx-5-i8.c: Ditto.
* gcc.target/riscv/rvv/autovec/vx_vf/vx-6-i16.c: Ditto.
* gcc.target/riscv/rvv/autovec/vx_vf/vx-6-i32.c: Ditto.
* gcc.target/riscv/rvv/autovec/vx_vf/vx-6-i64.c: Ditto.
* gcc.target/riscv/rvv/autovec/vx_vf/vx-6-i8.c: Ditto.
* gcc.target/riscv/rvv/autovec/vx_vf/vx_binary.h: Add test
helper macros.
* gcc.target/riscv/rvv/autovec/vx_vf/vx_binary_data.h: Add
test data for run test.
* gcc.target/riscv/rvv/autovec/vx_vf/vx_vaadd-run-2-i16.c: New test.
* gcc.target/riscv/rvv/autovec/vx_vf/vx_vaadd-run-2-i32.c: New test.
* gcc.target/riscv/rvv/autovec/vx_vf/vx_vaadd-run-2-i64.c: New test.
* gcc.target/riscv/rvv/autovec/vx_vf/vx_vaadd-run-2-i8.c: New test.
Signed-off-by: Pan Li
Diff:
---
.../gcc.target/riscv/rvv/autovec/vx_vf/vx-1-i16.c | 2 +-
.../gcc.target/riscv/rvv/autovec/vx_vf/vx-1-i32.c | 2 +-
.../gcc.target/riscv/rvv/autovec/vx_vf/vx-1-i64.c | 5 +-
.../gcc.target/riscv/rvv/autovec/vx_vf/vx-1-i8.c | 2 +-
.../gcc.target/riscv/rvv/autovec/vx_vf/vx-4-i16.c | 1 +
.../gcc.target/riscv/rvv/autovec/vx_vf/vx-4-i32.c | 1 +
.../gcc.target/riscv/rvv/autovec/vx_vf/vx-4-i64.c | 6 +-
.../gcc.target/riscv/rvv/autovec/vx_vf/vx-4-i8.c | 1 +
.../gcc.target/riscv/rvv/autovec/vx_vf/vx-5-i16.c | 1 +
.../gcc.target/riscv/rvv/autovec/vx_vf/vx-5-i32.c | 1 +
.../gcc.target/riscv/rvv/autovec/vx_vf/vx-5-i64.c | 1 +
.../gcc.target/riscv/rvv/autovec/vx_vf/vx-5-i8.c | 1 +
.../gcc.target/riscv/rvv/autovec/vx_vf/vx-6-i16.c | 1 +
.../gcc.target/riscv/rvv/autovec/vx_vf/vx-6-i32.c | 1 +
.../gcc.target/riscv/rvv/autovec/vx_vf/vx-6-i64.c | 1 +
.../gcc.target/riscv/rvv/autovec/vx_vf/vx-6-i8.c | 1 +
.../gcc.target/riscv/rvv/autovec/vx_vf/vx_binary.h | 6 +
.../riscv/rvv/autovec/vx_vf/vx_binary_data.h | 196 +
.../riscv/rvv/autovec/vx_vf/vx_vaadd-run-2-i16.c | 17 ++
.../riscv/rvv/autovec/vx_vf/vx_vaadd-run-2-i32.c | 17 ++
.../riscv/rvv/autovec/vx_vf/vx_vaadd-run-2-i64.c | 17 ++
.../riscv/rvv/autovec/vx_vf/vx_vaadd-run-2-i8.c| 17 ++
22 files changed, 293 insertions(+), 5 deletions(-)
diff --git a/gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-1-i16.c
b/gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-1-i16.c
index f84d7f5011c3..4e1a575f2c23 100644
--- a/gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-1-i16.c
+++ b/gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-1-i16.c
@@ -20,4 +20,4 @@ TEST_BINARY_VX_SIGNED_0(T)
/* { dg-final { scan-assembler-times {vmin.vx} 2 } } */
/* { dg-final { scan-assembler-times {vsadd.vx} 1 } } */
/* { dg-final { scan-assembler-times {vssub.vx} 1 } } */
-/* { dg-final { scan-assembler-times {vaadd.vx} 1 } } */
+/* { dg-final { scan-assembler-times {vaadd.vx} 2 } } */
diff --git a/gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-1-i32.c
b/gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-1-i32.c
index 70b67435dccc..4c4f72dd994f 100644
--- a/gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-1-i32.c
+++ b/gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-1-i32.c
@@ -20,4 +20,4 @@ TEST_BINARY_VX_SIGNED_0(T)
/* { dg-final { scan-assembler-times {vmin.vx} 2 } } */
/* { dg-final { scan-assembler-times {vsadd.vx} 1 } } */
/* { dg-final { scan-assembler-times {vssub.vx} 1 } } */
-/* { dg-final { scan-assembler-times {vaadd.vx} 1 } } */
+/* { dg-final { scan-assembler-times {vaadd.vx} 2 } } */
diff --git a/gcc/testsuite/gcc.target/riscv/rvv/autovec/vx_vf/vx-1-i64.c
b/gcc/testsuite/gcc.target/
[gcc r16-2689] Ada: Fix miscompilation of GNAT tools with -march=znver3
https://gcc.gnu.org/g:0cd52ca158ae74cffd55c480888019990a6bed3f commit r16-2689-g0cd52ca158ae74cffd55c480888019990a6bed3f Author: Eric Botcazou Date: Thu Jul 31 17:38:50 2025 +0200 Ada: Fix miscompilation of GNAT tools with -march=znver3 The throw and catch sides of the Ada exception machinery disagree about the BIGGEST_ALIGNMENT setting. gcc/ada/ PR ada/120440 * gcc-interface/Makefile.in (GNATLINK_OBJS): Add s-excmac.o. (GNATMAKE_OBJS): Likewise. Diff: --- gcc/ada/gcc-interface/Makefile.in | 8 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/gcc/ada/gcc-interface/Makefile.in b/gcc/ada/gcc-interface/Makefile.in index 8615b598623f..d456ac1966f2 100644 --- a/gcc/ada/gcc-interface/Makefile.in +++ b/gcc/ada/gcc-interface/Makefile.in @@ -314,16 +314,16 @@ Makefile: ../config.status $(srcdir)/ada/gcc-interface/Makefile.in $(srcdir)/ada GNATLINK_OBJS = gnatlink.o \ a-except.o ali.o alloc.o butil.o casing.o csets.o debug.o fmap.o fname.o \ gnatvsn.o hostparm.o indepsw.o interfac.o i-c.o i-cstrin.o namet.o opt.o \ - osint.o output.o rident.o s-exctab.o s-secsta.o s-stalib.o s-stoele.o \ - sdefault.o snames.o stylesw.o switch.o system.o table.o targparm.o \ - types.o validsw.o widechar.o + osint.o output.o rident.o s-excmac.o s-exctab.o s-secsta.o s-stalib.o \ + s-stoele.o sdefault.o snames.o stylesw.o switch.o system.o table.o \ + targparm.o types.o validsw.o widechar.o GNATMAKE_OBJS = a-except.o ali.o ali-util.o aspects.o s-casuti.o alloc.o \ atree.o binderr.o butil.o casing.o csets.o debug.o elists.o einfo.o errout.o \ erroutc.o errutil.o err_vars.o fmap.o fname.o fname-uf.o fname-sf.o \ gnatmake.o gnatvsn.o hostparm.o interfac.o i-c.o i-cstrin.o krunch.o lib.o \ make.o makeusg.o make_util.o namet.o nlists.o opt.o osint.o osint-m.o \ - output.o restrict.o rident.o s-exctab.o s-cautns.o \ + output.o restrict.o rident.o s-cautns.o s-excmac.o s-exctab.o \ s-secsta.o s-stalib.o s-stoele.o scans.o scng.o sdefault.o sfn_scan.o \ s-purexc.o s-htable.o scil_ll.o sem_aux.o sinfo.o sinput.o sinput-c.o \ snames.o stand.o stringt.o styleg.o stylesw.o system.o validsw.o \
[gcc r15-10177] Ada: Fix miscompilation of GNAT tools with -march=znver3
https://gcc.gnu.org/g:4cdf85859b8d19b91de8f2226fc0f0d79b3f2dbb commit r15-10177-g4cdf85859b8d19b91de8f2226fc0f0d79b3f2dbb Author: Eric Botcazou Date: Thu Jul 31 17:42:36 2025 +0200 Ada: Fix miscompilation of GNAT tools with -march=znver3 The throw and catch sides of the Ada exception machinery disagree about the BIGGEST_ALIGNMENT setting. gcc/ada/ PR ada/120440 * gcc-interface/Makefile.in (GNATLINK_OBJS): Add s-excmac.o. (GNATMAKE_OBJS): Likewise. Diff: --- gcc/ada/gcc-interface/Makefile.in | 8 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/gcc/ada/gcc-interface/Makefile.in b/gcc/ada/gcc-interface/Makefile.in index 4b412b9298eb..d8be9aa69eda 100644 --- a/gcc/ada/gcc-interface/Makefile.in +++ b/gcc/ada/gcc-interface/Makefile.in @@ -312,16 +312,16 @@ Makefile: ../config.status $(srcdir)/ada/gcc-interface/Makefile.in $(srcdir)/ada GNATLINK_OBJS = gnatlink.o \ a-except.o ali.o alloc.o butil.o casing.o csets.o debug.o fmap.o fname.o \ gnatvsn.o hostparm.o indepsw.o interfac.o i-c.o i-cstrin.o namet.o opt.o \ - osint.o output.o rident.o s-exctab.o s-secsta.o s-stalib.o s-stoele.o \ - sdefault.o snames.o stylesw.o switch.o system.o table.o targparm.o \ - types.o validsw.o widechar.o + osint.o output.o rident.o s-excmac.o s-exctab.o s-secsta.o s-stalib.o \ + s-stoele.o sdefault.o snames.o stylesw.o switch.o system.o table.o \ + targparm.o types.o validsw.o widechar.o GNATMAKE_OBJS = a-except.o ali.o ali-util.o aspects.o s-casuti.o alloc.o \ atree.o binderr.o butil.o casing.o csets.o debug.o elists.o einfo.o errout.o \ erroutc.o errutil.o err_vars.o fmap.o fname.o fname-uf.o fname-sf.o \ gnatmake.o gnatvsn.o hostparm.o interfac.o i-c.o i-cstrin.o krunch.o lib.o \ make.o makeusg.o make_util.o namet.o nlists.o opt.o osint.o osint-m.o \ - output.o restrict.o rident.o s-exctab.o \ + output.o restrict.o rident.o s-excmac.o s-exctab.o \ s-secsta.o s-stalib.o s-stoele.o scans.o scng.o sdefault.o sfn_scan.o \ s-purexc.o s-htable.o scil_ll.o sem_aux.o sinfo.o sinput.o sinput-c.o \ snames.o stand.o stringt.o styleg.o stylesw.o system.o validsw.o \
[gcc(refs/users/mikael/heads/refactor_descriptor_v08)] Suppression mise à jour upper bound.
https://gcc.gnu.org/g:72c57192eec92c50091a18a423b3307d4a30f61a commit 72c57192eec92c50091a18a423b3307d4a30f61a Author: Mikael Morin Date: Mon Mar 17 19:09:18 2025 +0100 Suppression mise à jour upper bound. Diff: --- gcc/fortran/trans-array.cc | 1 - 1 file changed, 1 deletion(-) diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc index 6b660e6d715e..cfec8571a35e 100644 --- a/gcc/fortran/trans-array.cc +++ b/gcc/fortran/trans-array.cc @@ -2546,7 +2546,6 @@ trans_array_constructor (gfc_ss * ss, locus * where) gfc_array_index_type, offsetvar, gfc_index_one_node); tmp = gfc_evaluate_now (tmp, &outer_loop->pre); - gfc_conv_descriptor_ubound_set (&loop->pre, desc, gfc_rank_cst[0], tmp); if (*loop_ubound0 && VAR_P (*loop_ubound0)) gfc_add_modify (&outer_loop->pre, *loop_ubound0, tmp); else
[gcc r16-2674] i386: Fix incorrect handling of simultaneous regparm and thiscall use
https://gcc.gnu.org/g:3b146853a3e8ca9f087d83173696fdcd332115e4
commit r16-2674-g3b146853a3e8ca9f087d83173696fdcd332115e4
Author: Artemiy Granat
Date: Thu Jul 24 18:38:26 2025 +0300
i386: Fix incorrect handling of simultaneous regparm and thiscall use
gcc/ChangeLog:
* config/i386/i386-options.cc (ix86_handle_cconv_attribute):
Handle simultaneous use of regparm and thiscall attributes in
case when regparm is set before thiscall.
gcc/testsuite/ChangeLog:
* gcc.target/i386/attributes-error.c: Add more attributes
combinations.
Diff:
---
gcc/config/i386/i386-options.cc | 4 +++
gcc/testsuite/gcc.target/i386/attributes-error.c | 41
2 files changed, 38 insertions(+), 7 deletions(-)
diff --git a/gcc/config/i386/i386-options.cc b/gcc/config/i386/i386-options.cc
index b3e9cabcde18..4ad209e5763b 100644
--- a/gcc/config/i386/i386-options.cc
+++ b/gcc/config/i386/i386-options.cc
@@ -3731,6 +3731,10 @@ ix86_handle_cconv_attribute (tree *node, tree name, tree
args, int,
{
error ("cdecl and thiscall attributes are not compatible");
}
+ if (lookup_attribute ("regparm", TYPE_ATTRIBUTES (*node)))
+ {
+ error ("regparm and thiscall attributes are not compatible");
+ }
}
/* Can combine sseregparm with all attributes. */
diff --git a/gcc/testsuite/gcc.target/i386/attributes-error.c
b/gcc/testsuite/gcc.target/i386/attributes-error.c
index 405eda50105e..935ea4db0af0 100644
--- a/gcc/testsuite/gcc.target/i386/attributes-error.c
+++ b/gcc/testsuite/gcc.target/i386/attributes-error.c
@@ -1,12 +1,39 @@
/* { dg-do compile } */
/* { dg-require-effective-target ia32 } */
-void foo1(int i, int j) __attribute__((fastcall, cdecl)); /* { dg-error "not
compatible" } */
-void foo2(int i, int j) __attribute__((fastcall, stdcall)); /* { dg-error "not
compatible" } */
+void foo1(int i, int j) __attribute__((cdecl, regparm(2)));
+void foo2(int i, int j) __attribute__((stdcall, regparm(2)));
void foo3(int i, int j) __attribute__((fastcall, regparm(2))); /* { dg-error
"not compatible" } */
-void foo4(int i, int j) __attribute__((stdcall, cdecl)); /* { dg-error "not
compatible" } */
-void foo5(int i, int j) __attribute__((stdcall, fastcall)); /* { dg-error "not
compatible" } */
-void foo6(int i, int j) __attribute__((cdecl, fastcall)); /* { dg-error "not
compatible" } */
-void foo7(int i, int j) __attribute__((cdecl, stdcall)); /* { dg-error "not
compatible" } */
-void foo8(int i, int j) __attribute__((regparm(2), fastcall)); /* { dg-error
"not compatible" } */
+void foo4(int i, int j) __attribute__((thiscall, regparm(2))); /* { dg-error
"not compatible" } */
+void foo5(int i, int j) __attribute__((sseregparm, regparm(2)));
+
+void foo6(int i, int j) __attribute__((stdcall, fastcall)); /* { dg-error "not
compatible" } */
+void foo7(int i, int j) __attribute__((regparm(2), fastcall)); /* { dg-error
"not compatible" } */
+void foo8(int i, int j) __attribute__((sseregparm, fastcall)); /* { dg-error
"not compatible" } */
+void foo9(int i, int j) __attribute__((thiscall, fastcall)); /* { dg-error
"not compatible" } */
+void foo10(int i, int j) __attribute__((sseregparm, fastcall));
+
+void foo11(int i, int j) __attribute__((cdecl, stdcall)); /* { dg-error "not
compatible" } */
+void foo12(int i, int j) __attribute__((fastcall, stdcall)); /* { dg-error
"not compatible" } */
+void foo13(int i, int j) __attribute__((thiscall, stdcall)); /* { dg-error
"not compatible" } */
+void foo14(int i, int j) __attribute__((regparm(2), stdcall));
+void foo15(int i, int j) __attribute__((sseregparm, stdcall));
+
+void foo16(int i, int j) __attribute__((stdcall, cdecl)); /* { dg-error "not
compatible" } */
+void foo17(int i, int j) __attribute__((fastcall, cdecl)); /* { dg-error "not
compatible" } */
+void foo18(int i, int j) __attribute__((thiscall, cdecl)); /* { dg-error "not
compatible" } */
+void foo19(int i, int j) __attribute__((regparm(2), cdecl));
+void foo20(int i, int j) __attribute__((sseregparm, cdecl));
+
+void foo21(int i, int j) __attribute__((stdcall, thiscall)); /* { dg-error
"not compatible" } */
+void foo22(int i, int j) __attribute__((fastcall, thiscall)); /* { dg-error
"not compatible" } */
+void foo23(int i, int j) __attribute__((cdecl, thiscall)); /* { dg-error "not
compatible" } */
+void foo24(int i, int j) __attribute__((regparm(2), thiscall)); /* { dg-error
"not compatible" } */
+void foo25(int i, int j) __attribute__((sseregparm, thiscall));
+
+void foo26(int i, int j) __attribute__((cdecl, sseregparm));
+void foo27(int i, int j) __attribute__((fastcall, sseregparm));
+void foo28(int i, int j) __attribute__((stdcall, sseregparm));
+void foo29(int i, int j) __attribute__((thiscall, sseregparm));
+void foo30(int i, int j) __attribute__((regparm(2), sseregparm));
[gcc r16-2672] i386: Ignore regparm attribute and warn for it in 64-bit mode
https://gcc.gnu.org/g:ccead81bbc39668376eb5cf47066acb446cc43f3
commit r16-2672-gccead81bbc39668376eb5cf47066acb446cc43f3
Author: Artemiy Granat
Date: Tue Jul 29 17:20:46 2025 +0300
i386: Ignore regparm attribute and warn for it in 64-bit mode
The regparm attribute does not affect code generation on x86-64 target.
Despite this, regparm was accepted silently, unlike other calling
convention attributes handled in the ix86_handle_cconv_attribute
function.
Due to lack of diagnostics, Linux kernel attempted to specify regparm(0)
on vmread_error_trampoline declaration, which is supposed to be invoked
with all arguments on stack:
https://lore.kernel.org/all/20220928232015.745948-1-sea...@google.com/
To produce a warning for regparm in 64-bit mode, simply move the block
that produces diagnostics above the block that handles the regparm
attribute.
gcc/ChangeLog:
* config/i386/i386-options.cc (ix86_handle_cconv_attribute):
Move 64-bit mode check before regparm handling.
gcc/testsuite/ChangeLog:
* g++.dg/abi/regparm1.C: Require ia32 target.
* gcc.target/i386/20020224-1.c: Likewise.
* gcc.target/i386/pr103785.c: Use regparm attribute only if
not in 64-bit mode.
* gcc.target/i386/pr36533.c: Likewise.
* gcc.target/i386/pr59099.c: Likewise.
* gcc.target/i386/sibcall-8.c: Likewise.
* gcc.target/i386/sw-1.c: Likewise.
* gcc.target/i386/pr15184-2.c: Fix invalid comment.
* gcc.target/i386/attributes-ignore.c: New test.
Diff:
---
gcc/config/i386/i386-options.cc | 24 +++
gcc/testsuite/g++.dg/abi/regparm1.C | 2 +-
gcc/testsuite/gcc.target/i386/20020224-1.c| 1 +
gcc/testsuite/gcc.target/i386/attributes-ignore.c | 8
gcc/testsuite/gcc.target/i386/pr103785.c | 5 -
gcc/testsuite/gcc.target/i386/pr15184-2.c | 2 +-
gcc/testsuite/gcc.target/i386/pr36533.c | 24 +++
gcc/testsuite/gcc.target/i386/pr59099.c | 9 -
gcc/testsuite/gcc.target/i386/sibcall-8.c | 14 +
gcc/testsuite/gcc.target/i386/sw-1.c | 5 -
10 files changed, 69 insertions(+), 25 deletions(-)
diff --git a/gcc/config/i386/i386-options.cc b/gcc/config/i386/i386-options.cc
index ca6bb836ab08..1ae3df895e3b 100644
--- a/gcc/config/i386/i386-options.cc
+++ b/gcc/config/i386/i386-options.cc
@@ -3615,6 +3615,18 @@ ix86_handle_cconv_attribute (tree *node, tree name, tree
args, int,
return NULL_TREE;
}
+ if (TARGET_64BIT)
+{
+ /* Do not warn when emulating the MS ABI. */
+ if ((TREE_CODE (*node) != FUNCTION_TYPE
+ && TREE_CODE (*node) != METHOD_TYPE)
+ || ix86_function_type_abi (*node) != MS_ABI)
+ warning (OPT_Wattributes, "%qE attribute ignored",
+name);
+ *no_add_attrs = true;
+ return NULL_TREE;
+}
+
/* Can combine regparm with all attributes but fastcall, and thiscall. */
if (is_attribute_p ("regparm", name))
{
@@ -3648,18 +3660,6 @@ ix86_handle_cconv_attribute (tree *node, tree name, tree
args, int,
return NULL_TREE;
}
- if (TARGET_64BIT)
-{
- /* Do not warn when emulating the MS ABI. */
- if ((TREE_CODE (*node) != FUNCTION_TYPE
- && TREE_CODE (*node) != METHOD_TYPE)
- || ix86_function_type_abi (*node) != MS_ABI)
- warning (OPT_Wattributes, "%qE attribute ignored",
-name);
- *no_add_attrs = true;
- return NULL_TREE;
-}
-
/* Can combine fastcall with stdcall (redundant) and sseregparm. */
if (is_attribute_p ("fastcall", name))
{
diff --git a/gcc/testsuite/g++.dg/abi/regparm1.C
b/gcc/testsuite/g++.dg/abi/regparm1.C
index c4710464acc2..3aae3dd207cd 100644
--- a/gcc/testsuite/g++.dg/abi/regparm1.C
+++ b/gcc/testsuite/g++.dg/abi/regparm1.C
@@ -1,5 +1,5 @@
// PR c++/29911 (9381)
-// { dg-do run { target i?86-*-* x86_64-*-* } }
+// { dg-do run { target { { i?86-*-* x86_64-*-* } && ia32 } } }
// { dg-require-effective-target c++11 }
extern "C" int printf(const char *, ...);
diff --git a/gcc/testsuite/gcc.target/i386/20020224-1.c
b/gcc/testsuite/gcc.target/i386/20020224-1.c
index 2905719fa62d..769332b37dcc 100644
--- a/gcc/testsuite/gcc.target/i386/20020224-1.c
+++ b/gcc/testsuite/gcc.target/i386/20020224-1.c
@@ -4,6 +4,7 @@
while callee was actually not poping it up (as the hidden argument
was passed in register). */
/* { dg-do run } */
+/* { dg-require-effective-target ia32 } */
/* { dg-options "-O2 -fomit-frame-pointer" } */
extern void abort (void);
diff --git a/gcc/testsuite/gcc.target/i386/attributes-ignore.c
b/gcc/testsuite/gcc.target/i386/attributes-ignore.c
new file mode 100644
index ..93a3770842c7
--- /dev/null
+++ b/gcc/testsuite/gc
[gcc r16-2675] i386: Fix typo in diagnostic about simultaneous regparm and thiscall use
https://gcc.gnu.org/g:df82965344f641c17a2df4bd7c195df9e980312b
commit r16-2675-gdf82965344f641c17a2df4bd7c195df9e980312b
Author: Artemiy Granat
Date: Thu Jul 24 18:38:27 2025 +0300
i386: Fix typo in diagnostic about simultaneous regparm and thiscall use
gcc/ChangeLog:
* config/i386/i386-options.cc (ix86_handle_cconv_attribute):
Fix typo.
Diff:
---
gcc/config/i386/i386-options.cc | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/gcc/config/i386/i386-options.cc b/gcc/config/i386/i386-options.cc
index 4ad209e5763b..09a35ef62980 100644
--- a/gcc/config/i386/i386-options.cc
+++ b/gcc/config/i386/i386-options.cc
@@ -3639,7 +3639,7 @@ ix86_handle_cconv_attribute (tree *node, tree name, tree
args, int,
if (lookup_attribute ("thiscall", TYPE_ATTRIBUTES (*node)))
{
- error ("regparam and thiscall attributes are not compatible");
+ error ("regparm and thiscall attributes are not compatible");
}
cst = TREE_VALUE (args);
[gcc r16-2673] i386: Fix incorrect comment about stdcall and fastcall compatibility
https://gcc.gnu.org/g:55e71d2a553a4455dede9fd94405dea3f81721a6
commit r16-2673-g55e71d2a553a4455dede9fd94405dea3f81721a6
Author: Artemiy Granat
Date: Thu Jul 24 18:38:25 2025 +0300
i386: Fix incorrect comment about stdcall and fastcall compatibility
gcc/ChangeLog:
* config/i386/i386-options.cc (ix86_handle_cconv_attribute):
Fix comments which state that combination of stdcall and fastcall
attributes is valid but redundant.
Diff:
---
gcc/config/i386/i386-options.cc | 5 ++---
1 file changed, 2 insertions(+), 3 deletions(-)
diff --git a/gcc/config/i386/i386-options.cc b/gcc/config/i386/i386-options.cc
index 1ae3df895e3b..b3e9cabcde18 100644
--- a/gcc/config/i386/i386-options.cc
+++ b/gcc/config/i386/i386-options.cc
@@ -3660,7 +3660,7 @@ ix86_handle_cconv_attribute (tree *node, tree name, tree
args, int,
return NULL_TREE;
}
- /* Can combine fastcall with stdcall (redundant) and sseregparm. */
+ /* Can combine fastcall with sseregparm. */
if (is_attribute_p ("fastcall", name))
{
if (lookup_attribute ("cdecl", TYPE_ATTRIBUTES (*node)))
@@ -3681,8 +3681,7 @@ ix86_handle_cconv_attribute (tree *node, tree name, tree
args, int,
}
}
- /* Can combine stdcall with fastcall (redundant), regparm and
- sseregparm. */
+ /* Can combine stdcall with regparm and sseregparm. */
else if (is_attribute_p ("stdcall", name))
{
if (lookup_attribute ("cdecl", TYPE_ATTRIBUTES (*node)))
[gcc(refs/users/mikael/heads/refactor_descriptor_v08)] Extraction set_gfc_from_cfi
https://gcc.gnu.org/g:4539ff30f4c5b14f39ee7c48980f04f36ddf2bb6
commit 4539ff30f4c5b14f39ee7c48980f04f36ddf2bb6
Author: Mikael Morin
Date: Tue Jul 22 19:51:53 2025 +0200
Extraction set_gfc_from_cfi
Diff:
---
gcc/fortran/trans-decl.cc | 210 +++-
gcc/fortran/trans-descriptor.cc | 197 +
gcc/fortran/trans-descriptor.h | 3 +-
3 files changed, 212 insertions(+), 198 deletions(-)
diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc
index f33bff9fe0b2..6916f50a5c2e 100644
--- a/gcc/fortran/trans-decl.cc
+++ b/gcc/fortran/trans-decl.cc
@@ -7047,7 +7047,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. */
@@ -7239,98 +7239,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_conv_descriptor_dtype_set (&block, 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_conv_descriptor_elem_len_set (&block, 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));
-
- /* 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 = gfc_conv_descriptor_type_set (gfc_desc, BT_VOID);
- tmp2 = gfc_conv_descriptor_type_set (gfc_desc, 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 = gfc_conv_descriptor_type_set (gfc_desc, 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 = gfc_conv_descriptor_type_set (gfc_desc, 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),
-CFI_type_ucs4_char));
- tmp = gfc_conv_descriptor_type_set (gfc_desc, BT_CHARACTER);
- tmp2 = fold_build3_loc (input_location, COND_EXPR, void_type_node, cond,
- tmp, 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 = gfc_conv_descriptor_ty
[gcc(refs/users/mikael/heads/refactor_descriptor_v08)] Extraction gfc_set_descriptor_from_scalar
https://gcc.gnu.org/g:4caa6ff7fed2fde8996026ff69c8475737df48e1
commit 4caa6ff7fed2fde8996026ff69c8475737df48e1
Author: Mikael Morin
Date: Tue Jul 22 20:50:41 2025 +0200
Extraction gfc_set_descriptor_from_scalar
Diff:
---
gcc/fortran/trans-descriptor.cc | 18 ++
gcc/fortran/trans-descriptor.h | 1 +
gcc/fortran/trans-expr.cc | 42 +
gcc/fortran/trans-types.cc | 22 +
gcc/fortran/trans-types.h | 1 +
5 files changed, 47 insertions(+), 37 deletions(-)
diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index e5fe8973b7b3..6995eb1da052 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -1864,3 +1864,21 @@ gfc_set_gfc_from_cfi (stmtblock_t *block, stmtblock_t
*block2, tree gfc_desc,
rank, LT_EXPR, build_int_cst (TREE_TYPE (idx), 1),
gfc_finish_block (&loop_body));
}
+
+
+void
+gfc_set_descriptor_from_scalar (stmtblock_t *block, tree descr,
+ tree scalar, gfc_expr *scalar_expr)
+{
+ tree type = gfc_get_scalar_to_descriptor_type (scalar,
+gfc_expr_attr (scalar_expr));
+ gfc_conv_descriptor_dtype_set (block, descr,
+gfc_get_dtype (type));
+
+ 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, descr, tmp);
+}
+
diff --git a/gcc/fortran/trans-descriptor.h b/gcc/fortran/trans-descriptor.h
index b4fa7eed6a36..0e87eee39b38 100644
--- a/gcc/fortran/trans-descriptor.h
+++ b/gcc/fortran/trans-descriptor.h
@@ -127,5 +127,6 @@ void gfc_set_gfc_from_cfi (stmtblock_t *, tree, gfc_expr *,
tree, tree,
tree, gfc_symbol *);
void gfc_set_gfc_from_cfi (stmtblock_t *, stmtblock_t *, tree, tree, tree,
gfc_symbol *, bool);
+void gfc_set_descriptor_from_scalar (stmtblock_t *, tree, tree, gfc_expr *);
#endif /* GFC_TRANS_DESCRIPTOR_H */
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index a1a07cabe4a0..95465cec1c02 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -91,33 +91,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, 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;
@@ -167,7 +146,7 @@ gfc_conv_scalar_to_descriptor (gfc_se *se, tree scalar,
symbol_attribute attr)
{
tree desc, type, etype;
- type = get_scalar_to_descriptor_type (scalar, attr);
+ type = gfc_get_scalar_to_descriptor_type (scalar, attr);
etype = TREE_TYPE (scalar);
desc = gfc_create_var (type, "desc");
DECL_ARTIFICIAL (desc) = 1;
@@ -982,8 +961,8 @@ gfc_conv_derived_to_class (gfc_se *parmse, gfc_expr *e,
gfc_symbol *fsym,
if (fsym->ts.u.derived->components->as)
{
tree type;
- type = get_scalar_to_descriptor_type (parmse->expr,
- gfc_expr_attr (e));
+ type = gfc_get_scalar_to_descriptor_type (parmse->expr,
+ gfc_expr_attr (e));
gfc_conv_descriptor_dtype_set (&parmse->pre, ctree,
gfc_get_dtype (type));
if (optional)
@@ -1368,18 +1347,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_conv_descriptor_dtype_set (&block, 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, ctr
[gcc(refs/users/mikael/heads/refactor_descriptor_v08)] Extraction gfc_set_gfc_from_cfi
https://gcc.gnu.org/g:9cd04072b31b9b7b4210f3abe0b1dbb672d1251a
commit 9cd04072b31b9b7b4210f3abe0b1dbb672d1251a
Author: Mikael Morin
Date: Tue Jul 22 12:17:50 2025 +0200
Extraction gfc_set_gfc_from_cfi
Diff:
---
gcc/fortran/trans-descriptor.cc | 98 +
gcc/fortran/trans-descriptor.h | 3 ++
gcc/fortran/trans-expr.cc | 92 +-
3 files changed, 102 insertions(+), 91 deletions(-)
diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index 4cc0eb2c0c58..93a15d06d3cd 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -1569,3 +1569,101 @@ gfc_set_subarray_descriptor (stmtblock_t *block, tree
descr, tree value,
}
}
+
+void
+gfc_set_gfc_from_cfi (stmtblock_t *block, tree gfc, gfc_expr *e, tree rank,
+ tree gfc_strlen, tree cfi, gfc_symbol *fsym)
+{
+ stmtblock_t block2;
+ gfc_init_block (&block2);
+ if (e->rank == 0)
+{
+ tree tmp = gfc_get_cfi_desc_base_addr (cfi);
+ gfc_add_modify (block, gfc, fold_convert (TREE_TYPE (gfc), tmp));
+}
+ else
+{
+ tree 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]);
+ 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 (&block2, gfc, tmp);
+
+ /* Calculate offset + set lbound, ubound and stride. */
+ gfc_conv_descriptor_offset_set (&block2, 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 (&block2, idx, build_int_cst (TREE_TYPE (idx), 0),
+ rank, LT_EXPR, build_int_cst (TREE_TYPE (idx), 1),
+ gfc_finish_block (&loop_body));
+}
+
+ if (e->ts.type == BT_CHARACTER && !e->ts.u.cl->length)
+{
+ tree tmp = fold_convert (gfc_charlen_type_node,
+ gfc_get_cfi_desc_elem_len (cfi));
+ if (e->ts.kind != 1)
+ tmp = fold_build2_loc (input_location, TRUNC_DIV_EXPR,
+ gfc_charlen_type_node, tmp,
+ build_int_cst (gfc_charlen_type_node,
+ e->ts.kind));
+ gfc_add_modify
[gcc(refs/users/mikael/heads/refactor_descriptor_v08)] Factorisation gfc_conv_shift_descriptor
https://gcc.gnu.org/g:8011a42ca387a30dc5ccb93ad2b67a303f6e35b4
commit 8011a42ca387a30dc5ccb93ad2b67a303f6e35b4
Author: Mikael Morin
Date: Fri Jul 18 14:45:07 2025 +0200
Factorisation gfc_conv_shift_descriptor
Factorisation gfc_conv_shift_descriptor
Diff:
---
gcc/fortran/trans-expr.cc | 7 +--
gcc/fortran/trans-stmt.cc | 6 +-
2 files changed, 2 insertions(+), 11 deletions(-)
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 3081a7fcc3a3..fe2e9f6475fc 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -1153,7 +1153,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
@@ -1221,11 +1220,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)
{
diff --git a/gcc/fortran/trans-stmt.cc b/gcc/fortran/trans-stmt.cc
index 07d42d293c6e..ddd0a120229c 100644
--- a/gcc/fortran/trans-stmt.cc
+++ b/gcc/fortran/trans-stmt.cc
@@ -2172,16 +2172,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_v08)] Extraction gfc_copy_sequence_descriptor
https://gcc.gnu.org/g:d13faeab8cd8bafe738485957f2ee9c591a32f30
commit d13faeab8cd8bafe738485957f2ee9c591a32f30
Author: Mikael Morin
Date: Wed Jul 23 16:34:39 2025 +0200
Extraction gfc_copy_sequence_descriptor
Diff:
---
gcc/fortran/trans-array.cc | 18 +-
gcc/fortran/trans-array.h | 1 +
gcc/fortran/trans-descriptor.cc | 22 ++
gcc/fortran/trans-descriptor.h | 2 ++
4 files changed, 26 insertions(+), 17 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index c7381f7cc261..9ca44736a1be 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -8886,23 +8886,7 @@ gfc_conv_array_parameter (gfc_se *se, gfc_expr *expr,
bool g77,
&& 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));
- tree tmp2 = gfc_conv_descriptor_dtype_get (se->expr);
- gfc_conv_descriptor_dtype_set (&block, arr, tmp2);
- gfc_conv_descriptor_rank_set (&block, arr, 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);
+ gfc_copy_sequence_descriptor (&block, arr, se->expr, expr->rank);
se->expr = arr;
}
gfc_class_array_data_assign (&block, tmp, se->expr, true);
diff --git a/gcc/fortran/trans-array.h b/gcc/fortran/trans-array.h
index 322160f47c4d..d5fa213cbf05 100644
--- a/gcc/fortran/trans-array.h
+++ b/gcc/fortran/trans-array.h
@@ -190,3 +190,4 @@ void gfc_trans_string_copy (stmtblock_t *, tree, tree, int,
tree, tree, int);
tree gfc_conv_array_extent_dim (tree, tree, tree*);
tree gfc_conv_descriptor_size (tree, int);
tree gfc_conv_descriptor_cosize (tree, int, int);
+
diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index 64fed46c7ab2..4a6cca9cc2bb 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -26,6 +26,7 @@ along with GCC; see the file COPYING3. If not see
#include "trans.h"
#include "trans-const.h"
#include "trans-types.h"
+#include "trans-array.h"
/**/
@@ -978,3 +979,24 @@ gfc_nullify_descriptor (stmtblock_t *block, tree descr)
{
gfc_conv_descriptor_data_set (block, descr, null_pointer_node);
}
+
+
+void
+gfc_copy_sequence_descriptor (stmtblock_t *block, tree dest, tree src, int
rank)
+{
+ gfc_conv_descriptor_data_set (block, dest,
+ gfc_conv_descriptor_data_get (src));
+ gfc_conv_descriptor_lbound_set (block, dest, gfc_index_zero_node,
+ gfc_index_zero_node);
+ gfc_conv_descriptor_ubound_set (block, dest, gfc_index_zero_node,
+ gfc_conv_descriptor_size (src, rank));
+ tree stride = gfc_conv_descriptor_stride_get (src, gfc_index_zero_node);
+ gfc_conv_descriptor_stride_set (block, dest, gfc_index_zero_node, stride);
+ gfc_conv_descriptor_dtype_set (block, dest,
+gfc_conv_descriptor_dtype_get (src));
+ gfc_conv_descriptor_rank_set (block, dest, 1);
+ gfc_conv_descriptor_span_set (block, dest,
+ gfc_conv_descriptor_span_get (src));
+ gfc_conv_descriptor_offset_set (block, dest, gfc_index_zero_node);
+}
+
diff --git a/gcc/fortran/trans-descriptor.h b/gcc/fortran/trans-descriptor.h
index 18b1f0109d3a..e5643b310de0 100644
--- a/gcc/fortran/trans-descriptor.h
+++ b/gcc/fortran/trans-descriptor.h
@@ -104,5 +104,7 @@ void gfc_conv_shift_descriptor (stmtblock_t *, tree, int);
void gfc_conv_shift_descriptor (stmtblock_t *, tree, const gfc_array_ref &);
/* Build a null array descriptor constructor. */
void gfc_nullify_descriptor (stmtblock_t *block, tree);
+void gfc_copy_sequence_descriptor (stmtblock_t *, tree, tree, int);
+
#endif /* GFC_TRANS_DESCRIPTOR_H */
[gcc(refs/users/mikael/heads/refactor_descriptor_v08)] Refactoring gfc_conv_descriptor_sm_get
https://gcc.gnu.org/g:23a97202c121f67a337ab9eaac343e98c32fa504
commit 23a97202c121f67a337ab9eaac343e98c32fa504
Author: Mikael Morin
Date: Tue Jul 22 11:32:27 2025 +0200
Refactoring gfc_conv_descriptor_sm_get
Diff:
---
gcc/fortran/trans-descriptor.cc | 7 +++
gcc/fortran/trans-descriptor.h | 1 +
gcc/fortran/trans-expr.cc | 6 ++
3 files changed, 10 insertions(+), 4 deletions(-)
diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index c9ecfea0dd79..4cc0eb2c0c58 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -601,6 +601,13 @@ gfc_conv_descriptor_ubound_set (stmtblock_t *block, tree
desc,
fold_convert_loc (loc, TREE_TYPE (t), value));
}
+tree
+gfc_conv_descriptor_sm_get (tree desc, tree dim)
+{
+ return fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
+ gfc_conv_descriptor_stride_get (desc, dim),
+ gfc_conv_descriptor_span_get (desc));
+}
/***
* Array descriptor higher level routines.
*
diff --git a/gcc/fortran/trans-descriptor.h b/gcc/fortran/trans-descriptor.h
index c9ad4541d970..3237265948ea 100644
--- a/gcc/fortran/trans-descriptor.h
+++ b/gcc/fortran/trans-descriptor.h
@@ -61,6 +61,7 @@ tree gfc_conv_descriptor_dimension_get (tree desc, int dim);
tree gfc_conv_descriptor_stride_get (tree desc, tree dim);
tree gfc_conv_descriptor_lbound_get (tree desc, tree dim);
tree gfc_conv_descriptor_ubound_get (tree desc, tree dim);
+tree gfc_conv_descriptor_sm_get (tree desc, tree dim);
void gfc_conv_descriptor_data_set (stmtblock_t *block, tree desc, tree value);
void gfc_conv_descriptor_data_set (stmtblock_t *block, tree desc, tree value);
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 54e7f587420e..8a2d9e6f3dd7 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -6325,10 +6325,8 @@ gfc_conv_gfc_desc_to_cfi_desc (gfc_se *parmse, gfc_expr
*e, gfc_symbol *fsym)
tmp = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
tmp, gfc_index_one_node);
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));
+ /* d->dim[n].sm = gfc->dim[i].stride * gfc->span); */
+ 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_v08)] Extraction gfc_conv_shift_subarray_descriptor
https://gcc.gnu.org/g:c934351af60554a17c6e930c53ef1649e03c9455
commit c934351af60554a17c6e930c53ef1649e03c9455
Author: Mikael Morin
Date: Tue Jul 22 11:16:59 2025 +0200
Extraction gfc_conv_shift_subarray_descriptor
Correction alloc_comp_constructor_5
Diff:
---
gcc/fortran/trans-descriptor.cc | 73 +++
gcc/fortran/trans-descriptor.h | 1 +
gcc/fortran/trans-expr.cc | 84 +++--
3 files changed, 80 insertions(+), 78 deletions(-)
diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index aeb93eda7fc7..c9ecfea0dd79 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -1489,3 +1489,76 @@ gfc_set_descriptor_with_shape (stmtblock_t *block, tree
desc,
gfc_conv_descriptor_offset_set (block, desc, offset);
}
+
+void
+gfc_set_subarray_descriptor (stmtblock_t *block, tree descr, 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. */
+ gfc_conv_descriptor_offset_set (block, descr, gfc_index_zero_node);
+ tree offset = gfc_conv_descriptor_offset_get (descr);
+ 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 (descr, 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 (descr, gfc_rank_cst[n]);
+ span = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
+ tmp, gfc_conv_descriptor_lbound_get (descr, gfc_rank_cst[n]));
+ tmp = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
+span, lbound);
+ gfc_conv_descriptor_ubound_set (block, descr, gfc_rank_cst[n], tmp);
+ gfc_conv_descriptor_lbound_set (block, descr, gfc_rank_cst[n], lbound);
+
+ tmp = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
+gfc_conv_descriptor_lbound_get (descr,
+gfc_rank_cst[n]),
+gfc_conv_descriptor_stride_get (descr,
+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, descr, tmp);
+}
+}
+
diff --git a/gcc/fortran/trans-descriptor.h b/gcc/fortran/trans-descriptor.h
index b17b71b09809..c9ad4541d970 100644
--- a/gcc/fortran/trans-descriptor.h
+++ b/gcc/fortran/trans-descriptor.h
@@ -121,5 +121,6 @@ gfc_set_descriptor (stmtblock_t *block, tree dest, tree
src, gfc_expr *src_expr,
void gfc_set_contiguous_descriptor (stmtblock_t *, tree, tree, tree);
void gfc_set_descriptor_with_shape (stmtblock_t *, tree, tree, gfc_expr *,
locus *);
+void gfc_set_subarray_descriptor (stmtblock_t *, tree, tree, gfc_expr *,
gfc_expr *);
#endif /* GFC_TRANS_DESCRIPTOR_H */
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index fe2e9f6475fc..54e7f587420e 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -9479,12 +9479,7 @@ gfc_trans_alloc_subarray_assign (tree dest,
gfc_component * cm,
{
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)
[gcc(refs/users/mikael/heads/refactor_descriptor_v08)] Extraction gfc_set_descriptor
https://gcc.gnu.org/g:f6e4787f0d1791cce81e1abfc98b57974720808c
commit f6e4787f0d1791cce81e1abfc98b57974720808c
Author: Mikael Morin
Date: Sun Jul 20 17:25:26 2025 +0200
Extraction gfc_set_descriptor
Correction bootstsrap
Diff:
---
gcc/fortran/trans-array.cc | 163 +-
gcc/fortran/trans-descriptor.cc | 169
gcc/fortran/trans-descriptor.h | 7 ++
3 files changed, 179 insertions(+), 160 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 5af9917124aa..72df5eb1062f 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -,7 +,6 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr)
tree tmp;
tree desc;
stmtblock_t block;
- tree start;
int full;
bool subref_array_target = false;
bool deferred_array_component = false;
@@ -8091,12 +8090,6 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr)
int dim, ndim, codim;
tree parm;
tree parmtype;
- tree dtype;
- tree stride;
- tree from;
- tree to;
- tree base;
- tree offset;
ndim = info->ref ? info->ref->u.ar.dimen : ss->dimen;
@@ -8217,160 +8210,10 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr)
gfc_get_array_span (desc, expr)));
}
- /* Set the span field. */
- tmp = NULL_TREE;
- if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (desc)))
- tmp = gfc_conv_descriptor_span_get (desc);
- else
- tmp = gfc_get_array_span (desc, expr);
- if (tmp)
- gfc_conv_descriptor_span_set (&loop.pre, parm, tmp);
-
- /* The following can be somewhat confusing. We have two
- descriptors, a new one and the original array.
- {parm, parmtype, dim} refer to the new one.
- {desc, 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. */
- if (se->unlimited_polymorphic)
- dtype = gfc_get_dtype (TREE_TYPE (desc), &loop.dimen);
- else if (expr->ts.type == BT_ASSUMED)
- {
- tree tmp2 = desc;
- 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_get (tmp2);
- }
- else
- dtype = gfc_get_dtype (parmtype);
- gfc_conv_descriptor_dtype_set (&loop.pre, parm, dtype);
-
- /* The 1st element in the section. */
- base = gfc_index_zero_node;
- if (expr->ts.type == BT_CHARACTER && expr->rank == 0 && codim)
- base = gfc_index_one_node;
-
- /* The offset from the 1st element in the section. */
- offset = gfc_index_zero_node;
-
- for (n = 0; n < ndim; n++)
- {
- stride = gfc_conv_array_stride (desc, n);
-
- /* Work out the 1st element in the section. */
- 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, &loop.pre);
- }
-
- tmp = gfc_conv_array_lbound (desc, 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)
- {
- /* For elemental dimensions, we only need the 1st
-element in the section. */
- continue;
- }
-
- /* Vector subscripts need copying and are handled elsewhere. */
- if (info->ref)
- gcc_assert (info->ref->u.ar.dimen_type[n] == DIMEN_RANGE);
-
- /* look for the corresponding scalarizer dimension: dim. */
- for (dim = 0; dim < ndim; dim++)
- if (ss->dim[dim] == n)
- break;
-
- /* loop exited early: the DIM being looked for has been found. */
- gcc_assert (dim < ndim);
+ gfc_set_descriptor (&loop.pre, parm, desc, expr, loop.dimen
[gcc(refs/users/mikael/heads/refactor_descriptor_v08)] Extraction gfc_init_absent_descriptor
https://gcc.gnu.org/g:a1229258129202a7ad11928788805b256c7c03e7
commit a1229258129202a7ad11928788805b256c7c03e7
Author: Mikael Morin
Date: Tue Jul 15 21:49:27 2025 +0200
Extraction gfc_init_absent_descriptor
Correction gfc_clear_descriptor assumed rank
Correction partielle class_optional_2
Correction class_optional_2
Diff:
---
gcc/fortran/trans-descriptor.cc | 31 +++
gcc/fortran/trans-descriptor.h | 2 +-
gcc/fortran/trans-expr.cc | 5 ++---
3 files changed, 30 insertions(+), 8 deletions(-)
diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index 26fd6ba4fcf8..e3762d70bb36 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -670,15 +670,15 @@ gfc_get_descriptor_offsets_for_info (const_tree
desc_type, tree *data_off,
#undef LBOUND_SUBFIELD
#undef UBOUND_SUBFIELD
-
void
-gfc_init_descriptor_variable (stmtblock_t *block, gfc_symbol *sym, tree descr)
+gfc_init_descriptor_variable (stmtblock_t *block, gfc_symbol *sym, gfc_expr
*expr, tree descr)
{
symbol_attribute attr = gfc_symbol_attr (sym);
/* NULLIFY the data pointer for non-saved allocatables, or for non-saved
pointers when -fcheck=pointer is specified. */
if (attr.allocatable
+ || attr.optional
|| (attr.pointer && (gfc_option.rtcheck & GFC_RTCHECK_POINTER)))
{
gfc_conv_descriptor_data_set (block, descr, null_pointer_node);
@@ -694,10 +694,26 @@ gfc_init_descriptor_variable (stmtblock_t *block,
gfc_symbol *sym, tree descr)
else
as = sym->as;
- gcc_assert (as && as->rank >= 0);
+ int rank;
+ if (as == nullptr)
+rank = 0;
+ else if (as->type != AS_ASSUMED_RANK)
+rank = as->rank;
+ else if (expr)
+rank = expr->rank;
+ else
+rank = -1;
+
etype = gfc_get_element_type (TREE_TYPE (descr));
gfc_conv_descriptor_dtype_set (block, descr,
-gfc_get_dtype_rank_type (as->rank, etype));
+gfc_get_dtype_rank_type (rank, etype));
+}
+
+
+void
+gfc_init_descriptor_variable (stmtblock_t *block, gfc_symbol *sym, tree descr)
+{
+ return gfc_init_descriptor_variable (block, sym, nullptr, descr);
}
@@ -748,3 +764,10 @@ gfc_build_default_class_descriptor (const gfc_typespec
&ts, tree class_type)
return gfc_class_set_static_fields (class_type, vptr, tmp);
}
+
+void
+gfc_init_absent_descriptor (stmtblock_t *block, tree descr)
+{
+ gfc_conv_descriptor_data_set (block, descr, null_pointer_node);
+}
+
diff --git a/gcc/fortran/trans-descriptor.h b/gcc/fortran/trans-descriptor.h
index f28565d783ee..de57a8e606e8 100644
--- a/gcc/fortran/trans-descriptor.h
+++ b/gcc/fortran/trans-descriptor.h
@@ -20,7 +20,6 @@ along with GCC; see the file COPYING3. If not see
#define GFC_TRANS_DESCRIPTOR_H
/* Build a null array descriptor constructor. */
-tree gfc_build_null_descriptor (tree);
tree gfc_build_default_class_descriptor (const gfc_typespec &, tree);
void gfc_nullify_descriptor (stmtblock_t *block, gfc_expr *, tree);
void gfc_set_scalar_null_descriptor (stmtblock_t *block, tree, gfc_symbol *,
gfc_expr *, tree);
@@ -97,5 +96,6 @@ gfc_get_descriptor_offsets_for_info (const_tree desc_type,
tree *data_off,
void gfc_init_descriptor_variable (stmtblock_t *block, gfc_symbol *sym, tree
descr);
void gfc_init_descriptor_result (stmtblock_t *block, tree descr);
void gfc_init_static_descriptor (tree descr);
+void gfc_init_absent_descriptor (stmtblock_t *block, tree descr);
#endif /* GFC_TRANS_DESCRIPTOR_H */
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 868566d8d8d5..6521c08e01f3 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -999,10 +999,9 @@ gfc_conv_derived_to_class (gfc_se *parmse, gfc_expr *e,
gfc_symbol *fsym,
tmp = gfc_finish_block (&block);
gfc_init_block (&block);
- gfc_conv_descriptor_data_set (&block, ctree, null_pointer_node);
+ gfc_init_absent_descriptor (&block, ctree);
if (derived_array && *derived_array != NULL_TREE)
- gfc_conv_descriptor_data_set (&block, *derived_array,
- null_pointer_node);
+ gfc_init_absent_descriptor (&block, *derived_array);
tmp = build3_v (COND_EXPR, cond_optional, tmp,
gfc_finish_block (&block));
[gcc(refs/users/mikael/heads/refactor_descriptor_v08)] Extraction gfc_copy_descriptor
https://gcc.gnu.org/g:5c8e7f7ef823fcd1f4c6b8e76cb137520623b6f2
commit 5c8e7f7ef823fcd1f4c6b8e76cb137520623b6f2
Author: Mikael Morin
Date: Wed Jul 16 22:09:17 2025 +0200
Extraction gfc_copy_descriptor
Diff:
---
gcc/fortran/trans-array.cc | 25 ++---
gcc/fortran/trans-descriptor.cc | 33 +
gcc/fortran/trans-descriptor.h | 1 +
3 files changed, 36 insertions(+), 23 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 980f4069fdcd..5af9917124aa 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -7869,29 +7869,8 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr)
if (full && !transposed_dims (ss))
{
if (se->direct_byref && !se->byref_noassign)
- {
- struct lang_type *lhs_ls
- = TYPE_LANG_SPECIFIC (TREE_TYPE (se->expr)),
- *rhs_ls = TYPE_LANG_SPECIFIC (TREE_TYPE (desc));
- /* When only the array_kind differs, do a view_convert. */
- tmp = lhs_ls && rhs_ls && lhs_ls->rank == rhs_ls->rank
- && lhs_ls->akind != rhs_ls->akind
- ? build1 (VIEW_CONVERT_EXPR, TREE_TYPE (se->expr), desc)
- : desc;
- /* Copy the descriptor for pointer assignments. */
- gfc_add_modify (&se->pre, se->expr, tmp);
-
- /* 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);
- }
+ gfc_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
diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index 6ca84c84e9ee..50404826d616 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -1191,3 +1191,36 @@ gfc_conv_shift_descriptor (stmtblock_t *block, tree
dest, tree src,
gfc_conv_descriptor_offset_set (block, dest, offset);
}
+
+void
+gfc_copy_descriptor (stmtblock_t *block, tree dest, tree src,
+gfc_expr *src_expr, bool subref)
+{
+ struct lang_type *dest_ls = TYPE_LANG_SPECIFIC (TREE_TYPE (dest));
+ struct lang_type *src_ls = TYPE_LANG_SPECIFIC (TREE_TYPE (src));
+
+ /* When only the array_kind differs, do a view_convert. */
+ tree tmp1;
+ if (dest_ls
+ && src_ls
+ && dest_ls->rank == src_ls->rank
+ && dest_ls->akind != src_ls->akind)
+tmp1 = build1 (VIEW_CONVERT_EXPR, TREE_TYPE (dest), src);
+ else
+tmp1 = src;
+
+ /* Copy the descriptor for pointer assignments. */
+ gfc_add_modify (block, dest, tmp1);
+
+ /* Add any offsets from subreferences. */
+ gfc_get_dataptr_offset (block, dest, src, NULL_TREE, subref, src_expr);
+
+ /* and set the span field. */
+ tree tmp2;
+ if (src_expr->ts.type == BT_CHARACTER)
+tmp2 = gfc_conv_descriptor_span_get (src);
+ else
+tmp2 = gfc_get_array_span (src, src_expr);
+ gfc_conv_descriptor_span_set (block, dest, tmp2);
+}
+
diff --git a/gcc/fortran/trans-descriptor.h b/gcc/fortran/trans-descriptor.h
index 5d4981ec29b1..5ae3f88cad54 100644
--- a/gcc/fortran/trans-descriptor.h
+++ b/gcc/fortran/trans-descriptor.h
@@ -110,5 +110,6 @@ void gfc_copy_sequence_descriptor (stmtblock_t *, tree,
tree, int);
void gfc_conv_remap_descriptor (stmtblock_t *, tree, int, tree, int,
gfc_array_ref *);
void gfc_conv_shift_descriptor (stmtblock_t *, tree, tree, int, tree);
+void gfc_copy_descriptor (stmtblock_t *, tree, tree, gfc_expr *, bool);
#endif /* GFC_TRANS_DESCRIPTOR_H */
[gcc(refs/users/mikael/heads/refactor_descriptor_v08)] Modif gfc_init_descriptor_variable
https://gcc.gnu.org/g:b2c1ff9b8b984ff851817c343b88bc9a20e48106
commit b2c1ff9b8b984ff851817c343b88bc9a20e48106
Author: Mikael Morin
Date: Sat Jul 19 15:55:19 2025 +0200
Modif gfc_init_descriptor_variable
Diff:
---
gcc/fortran/trans-descriptor.cc | 20 +---
1 file changed, 13 insertions(+), 7 deletions(-)
diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index f89ad587f62f..cc25347551a6 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -673,22 +673,28 @@ gfc_get_descriptor_offsets_for_info (const_tree
desc_type, tree *data_off,
void
gfc_init_descriptor_variable (stmtblock_t *block, gfc_symbol *sym, tree descr)
{
+ symbol_attribute attr = gfc_symbol_attr (sym);
+
/* NULLIFY the data pointer for non-saved allocatables, or for non-saved
pointers when -fcheck=pointer is specified. */
- if (sym->attr.allocatable
- || (sym->attr.pointer && (gfc_option.rtcheck & GFC_RTCHECK_POINTER)))
+ if (attr.allocatable
+ || (attr.pointer && (gfc_option.rtcheck & GFC_RTCHECK_POINTER)))
{
gfc_conv_descriptor_data_set (block, descr, null_pointer_node);
- if (flag_coarray == GFC_FCOARRAY_LIB && sym->attr.codimension)
+ if (flag_coarray == GFC_FCOARRAY_LIB && attr.codimension)
gfc_conv_descriptor_token_set (block, descr, null_pointer_node);
}
tree etype;
- gcc_assert (sym->as && sym->as->rank>=0);
+ gfc_array_spec *as;
+ if (sym->ts.type == BT_CLASS)
+as = CLASS_DATA (sym)->as;
+ else
+as = sym->as;
+
+ gcc_assert (as && as->rank >= 0);
etype = gfc_get_element_type (TREE_TYPE (descr));
gfc_conv_descriptor_dtype_set (block, descr,
-gfc_get_dtype_rank_type (sym->as->rank,
- etype));
+gfc_get_dtype_rank_type (as->rank, etype));
}
-
[gcc(refs/users/mikael/heads/refactor_descriptor_v08)] Mise à jour offset & span dans gfc_array_init_size
https://gcc.gnu.org/g:7678d3467841659e7f3723ac79d19ba9183002b0
commit 7678d3467841659e7f3723ac79d19ba9183002b0
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 | 30 ++
1 file changed, 10 insertions(+), 20 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index c639659cd698..24f4d9695a0f 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -5814,8 +5814,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, gfc_expr *expr3, tree expr3_desc,
bool e3_has_nodescriptor, gfc_expr *expr,
@@ -6058,6 +6058,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);
+
stride = fold_convert (size_type_node, stride);
/* First check for overflow. Since an array of type character can
@@ -6084,12 +6090,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))
@@ -6151,7 +6151,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;
@@ -6280,9 +6279,8 @@ 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, expr3, e3_arr_desc,
+ lower, upper, &se->pre, &set_descriptor_block,
+ &overflow, expr3_elem_size, expr3, e3_arr_desc,
e3_has_nodescriptor, expr, element_size,
explicit_ts);
@@ -6420,14 +6418,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_v08)] Suppression mise à jour offset forall
https://gcc.gnu.org/g:d79db5044eb1be4b0fb8d32e14dc9bf311ce3589
commit d79db5044eb1be4b0fb8d32e14dc9bf311ce3589
Author: Mikael Morin
Date: Mon Feb 17 17:28:01 2025 +0100
Suppression mise à jour offset forall
Sauvegarde
Correction régression forall
Diff:
---
gcc/fortran/trans-array.cc | 55 +
gcc/fortran/trans-array.h | 3 ++-
gcc/fortran/trans-descriptor.cc | 37 ++-
gcc/fortran/trans-descriptor.h | 4 ++-
gcc/fortran/trans-expr.cc | 4 ++-
gcc/fortran/trans-stmt.cc | 10 ++--
gcc/fortran/trans.h | 4 ++-
7 files changed, 78 insertions(+), 39 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index f895c3c7e286..80e3b767ff76 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -960,7 +960,8 @@ get_class_info_from_ss (stmtblock_t * pre, gfc_ss *ss, tree
*eltype,
tree
gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, gfc_ss *
ss,
tree eltype, tree initial, bool dynamic,
-bool dealloc, bool callee_alloc, locus * where)
+bool dealloc, bool callee_alloc, locus * where,
+bool shift_bounds)
{
gfc_loopinfo *loop;
gfc_ss *s;
@@ -1048,19 +1049,23 @@ gfc_trans_create_temp_array (stmtblock_t * pre,
stmtblock_t * post, gfc_ss * ss,
{
dim = s->dim[n];
- /* Callee allocated arrays may not have a known bound yet. */
- if (loop->to[n])
- loop->to[n] = gfc_evaluate_now (
- fold_build2_loc (input_location, MINUS_EXPR,
-gfc_array_index_type,
-loop->to[n], loop->from[n]),
- pre);
- loop->from[n] = gfc_index_zero_node;
+ if (shift_bounds)
+ {
+ /* Callee allocated arrays may not have a known bound yet. */
+ if (loop->to[n])
+ {
+ tree t = fold_build2_loc (input_location, MINUS_EXPR,
+ gfc_array_index_type,
+ loop->to[n], loop->from[n]);
+ loop->to[n] = gfc_evaluate_now (t, pre);
+ }
+ loop->from[n] = gfc_index_zero_node;
- /* We have just changed the loop bounds, we must clear the
-corresponding specloop, so that delta calculation is not skipped
-later in gfc_set_delta. */
- loop->specloop[n] = NULL;
+ /* We have just changed the loop bounds, we must clear the
+corresponding specloop, so that delta calculation is not
+skipped later in gfc_set_delta. */
+ loop->specloop[n] = NULL;
+ }
/* We are constructing the temporary's descriptor based on the loop
dimensions. As the dimensions may be accessed in arbitrary order
@@ -1221,13 +1226,18 @@ gfc_trans_create_temp_array (stmtblock_t * pre,
stmtblock_t * post, gfc_ss * ss,
{
stride[n] = size;
- tmp = fold_build2_loc (input_location, PLUS_EXPR,
-gfc_array_index_type,
-to[n], gfc_index_one_node);
+ tmp = gfc_index_one_node;
+ if (!shift_bounds && !integer_zerop (from[n]))
+ tmp = fold_build2_loc (input_location, MINUS_EXPR,
+ gfc_array_index_type,
+ gfc_index_one_node, from[n]);
+
+ tree extent = fold_build2_loc (input_location, PLUS_EXPR,
+gfc_array_index_type, to[n], tmp);
/* Check whether the size for this dimension is negative. */
cond = fold_build2_loc (input_location, LE_EXPR, logical_type_node,
- tmp, gfc_index_zero_node);
+ extent, gfc_index_zero_node);
cond = gfc_evaluate_now (cond, pre);
if (n == 0)
@@ -1237,7 +1247,7 @@ gfc_trans_create_temp_array (stmtblock_t * pre,
stmtblock_t * post, gfc_ss * ss,
logical_type_node, or_expr, cond);
size = fold_build2_loc (input_location, MULT_EXPR,
- gfc_array_index_type, size, tmp);
+ gfc_array_index_type, size, extent);
size = gfc_evaluate_now (size, pre);
}
}
@@ -1265,9 +1275,9 @@ gfc_trans_create_temp_array (stmtblock_t * pre,
stmtblock_t * post, gfc_ss * ss,
dealloc);
gfc_set_temporary_descriptor (pre, desc, class_expr, elemsize, data_ptr,
- to, stride, total_dim,
+ from, to, stride, total_dim,
[gcc(refs/users/mikael/heads/refactor_descriptor_v08)] Factorisation set descriptor with shape
https://gcc.gnu.org/g:0d9698e3dc5baba7d5ad27a5ceb9b34973c1ac20
commit 0d9698e3dc5baba7d5ad27a5ceb9b34973c1ac20
Author: Mikael Morin
Date: Tue Jul 22 10:03:33 2025 +0200
Factorisation set descriptor with shape
Diff:
---
gcc/fortran/trans-descriptor.cc | 78 +
gcc/fortran/trans-descriptor.h | 2 ++
gcc/fortran/trans-intrinsic.cc | 76 +++
3 files changed, 85 insertions(+), 71 deletions(-)
diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index e8cb4831f559..aeb93eda7fc7 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -1411,3 +1411,81 @@ gfc_set_contiguous_descriptor (stmtblock_t *block, tree
desc, tree size,
gfc_index_zero_node, size);
gfc_conv_descriptor_data_set (block, desc, data_ptr);
}
+
+
+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_conv_descriptor_dtype_set (block, 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);
+}
+
diff --git a/gcc/fortran/trans-descriptor.h b/gcc/fortran/trans-descriptor.h
index 818f3f319566..b17b71b09809 100644
--- a/gcc/fortran/trans-descriptor.h
+++ b/gcc/fortran/trans-descriptor.h
@@ -119,5 +119,7 @@ gfc_set_descriptor (stmtblock_t *block, tree dest, tree
src, gfc_expr *src_expr,
bool unlimited_polymorphic, bool data_needed,
bool subref);
void gfc_set_contiguous_descriptor (stmtblock_t *, tree, tree, tree);
+void gfc_set_descriptor_with_shape (stmtblock_t *, tree, tree, gfc_expr *,
+ locus *);
#endif /* GFC_TRANS_DESCRIPTOR_H */
diff --git a/gcc/fortran/trans-intrinsic.cc b/gcc/fortran/trans-intrinsic.cc
index 314323c29c81..e863964755f7 100644
--- a/gcc/fortran/trans-intrinsic.cc
+++ b/gcc/fortran/trans-intrinsic.cc
@@ -9917,11 +9917,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;
- stmtblock_t body, block;
- gfc_loopinfo loop;
+ tree desc;
+ stmtblock_t block;
gfc_actu
[gcc(refs/users/mikael/heads/refactor_descriptor_v08)] Extraction gfc_set_temporary_descriptor
https://gcc.gnu.org/g:aaab7ec26d91a8f5fe5bbbca8213da472c44d03d
commit aaab7ec26d91a8f5fe5bbbca8213da472c44d03d
Author: Mikael Morin
Date: Wed Jul 23 12:12:01 2025 +0200
Extraction gfc_set_temporary_descriptor
Diff:
---
gcc/fortran/trans-array.cc | 62 +
gcc/fortran/trans-descriptor.cc | 54 +++
gcc/fortran/trans-descriptor.h | 3 ++
3 files changed, 76 insertions(+), 43 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 807de4f8ae32..dc13d13c32d1 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -624,13 +624,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;
@@ -638,7 +639,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
@@ -666,8 +667,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
{
@@ -675,7 +675,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
{
@@ -718,18 +718,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. */
@@ -737,6 +731,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;
}
@@ -970,6 +966,7 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t
* post, gfc_ss * ss,
gfc_ss *s;
gfc_array_info *info;
tree from[GFC_MAX_DIMENSIONS], to[GFC_MAX_DIMENSIONS];
+ tree stride[GFC_MAX_DIMENSIONS];
tree type;
tree desc;
tree tmp;
@@ -1105,13 +1102,12 @@ gfc_trans_create_temp_array (stmtblock_t * pre,
stmtblock_t * post, gfc_ss * ss,
TREE_USED (desc) = 0;
}
+ bool rank_changer = false;
if (class_expr != NULL_TREE
|| (fcn_ss && fcn_ss->info && fcn_ss->info->class_container))
{
tree class_data;
- tree dtype;
gfc_expr *expr1 = fcn_ss ? fcn_ss->info->expr : NULL;
- bool rank_changer;
/* Pick out these transformational functions because they change the rank
or shape of the first argument. This requires that the class type be
@@ -1165,17 +1161,7 @@ gfc_trans_create_temp_array (stmtblock_t * pre,
stmtblock_t * post, gfc_ss * ss,
class_data = gfc_class_data_get (tmp);
if (rank_changer)
- {
- /* Take the dtype from the class expression. */
- tree class_descr = gfc_class_data_get (class_expr);
- dtype = gfc_conv_descriptor_dtype_get (class_descr);
- gfc_conv_descriptor_dtype_set (pre, desc, dtype);
-
-
- /* These transformational functions change the rank. */
- gfc_conv_descriptor_rank_set (pre, desc, ss->loop->dimen);
- fcn_ss->info->class_container = NULL_TREE;
- }
+ fcn_ss->info->class_container = NULL_TREE;
/* Assign the new descriptor to the _data field. This allows the
vptr _copy to be used for scalarized assig
[gcc(refs/users/mikael/heads/refactor_descriptor_v08)] Extraction gfc_set_descriptor_from_scalar
https://gcc.gnu.org/g:d5a26d5d8fa2a9a0ca4ffe5ede86e7596ec74b14
commit d5a26d5d8fa2a9a0ca4ffe5ede86e7596ec74b14
Author: Mikael Morin
Date: Tue Jul 22 21:14:56 2025 +0200
Extraction gfc_set_descriptor_from_scalar
Correction code en doublon
Diff:
---
gcc/fortran/trans-descriptor.cc | 17 +
gcc/fortran/trans-descriptor.h | 1 +
gcc/fortran/trans-expr.cc | 14 +++---
3 files changed, 21 insertions(+), 11 deletions(-)
diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index cef609e0464b..a9469c639ae4 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -1902,3 +1902,20 @@ gfc_set_descriptor_from_scalar (stmtblock_t *block, tree
descr,
gfc_conv_descriptor_data_set (block, descr, scalar);
}
+
+void
+gfc_set_descriptor_from_scalar (stmtblock_t *block, tree descr, tree scalar)
+{
+ tree etype = TREE_TYPE (scalar);
+ 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_conv_descriptor_dtype_set (block, descr,
+gfc_get_dtype_rank_type (0, etype));
+ gfc_conv_descriptor_data_set (block, descr, scalar);
+ gfc_conv_descriptor_span_set (block, descr,
+ gfc_conv_descriptor_elem_len_get (descr));
+}
+
diff --git a/gcc/fortran/trans-descriptor.h b/gcc/fortran/trans-descriptor.h
index 32b045ac8c1b..7e6e2871bc5e 100644
--- a/gcc/fortran/trans-descriptor.h
+++ b/gcc/fortran/trans-descriptor.h
@@ -127,6 +127,7 @@ void gfc_set_gfc_from_cfi (stmtblock_t *, tree, gfc_expr *,
tree, tree,
tree, gfc_symbol *);
void gfc_set_gfc_from_cfi (stmtblock_t *, stmtblock_t *, tree, tree, tree,
gfc_symbol *, bool);
+void gfc_set_descriptor_from_scalar (stmtblock_t *, tree, tree);
void gfc_set_descriptor_from_scalar (stmtblock_t *, tree, tree, gfc_expr *);
void gfc_set_descriptor_from_scalar (stmtblock_t *, tree, tree, gfc_expr *,
tree);
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index e0115c953de0..88fda9047eac 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -144,10 +144,9 @@ gfc_conv_null_array_descriptor (gfc_se *se, gfc_symbol
*sym, gfc_expr *expr)
tree
gfc_conv_scalar_to_descriptor (gfc_se *se, tree scalar, symbol_attribute attr)
{
- tree desc, type, etype;
+ tree desc, type;
type = gfc_get_scalar_to_descriptor_type (scalar, attr);
- etype = TREE_TYPE (scalar);
desc = gfc_create_var (type, "desc");
DECL_ARTIFICIAL (desc) = 1;
@@ -158,15 +157,8 @@ 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_conv_descriptor_dtype_set (&se->pre, 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_get (desc));
+
+ gfc_set_descriptor_from_scalar (&se->pre, desc, scalar);
/* Copy pointer address back - but only if it could have changed and
if the actual argument is a pointer and not, e.g., NULL(). */
[gcc(refs/users/mikael/heads/refactor_descriptor_v08)] Factorisation gfc_set_contiguous_descriptor
https://gcc.gnu.org/g:49b29209112310107684b8f6d1638aa9f2aeff1f
commit 49b29209112310107684b8f6d1638aa9f2aeff1f
Author: Mikael Morin
Date: Fri Jan 17 17:25:59 2025 +0100
Factorisation gfc_set_contiguous_descriptor
Factorisation set_contiguous_array
Diff:
---
gcc/fortran/trans-array.cc | 54 +++--
gcc/fortran/trans-descriptor.cc | 18 ++
gcc/fortran/trans-descriptor.h | 1 +
3 files changed, 33 insertions(+), 40 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 72df5eb1062f..28dee67e8154 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -9497,32 +9497,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_conv_descriptor_dtype_set (&tmpblock, 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)))
@@ -9545,13 +9519,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;
+
+ gfc_set_contiguous_descriptor (&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),
@@ -9699,21 +9683,11 @@ structure_alloc_comps (gfc_symbol * der_type, tree
decl, tree dest,
cdesc = gfc_create_var (cdesc, "cdesc");
DECL_ARTIFICIAL (cdesc) = 1;
- gfc_conv_descriptor_dtype_set (&dealloc_block, 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);
+ gfc_set_contiguous_descriptor (&dealloc_block, cdesc, ubound,
+comp);
/* Now call the deallocator. */
vtab = gfc_find_vtab (&c->ts);
diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index 240f0c46fd27..e8cb4831f559 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -1393,3 +1393,21 @@ gfc_set_descriptor (stmtblock_t *block, tree dest, tree
src,
[gcc(refs/users/mikael/heads/refactor_descriptor_v08)] Factorisation descriptor_element_size
https://gcc.gnu.org/g:09730ed88847ae9299141954f474c4b4ad4d9adb
commit 09730ed88847ae9299141954f474c4b4ad4d9adb
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 dc13d13c32d1..c639659cd698 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -5742,6 +5742,46 @@ gfc_conv_array_extent_dim (tree lbound, tree ubound,
tree* or_expr)
}
+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,
@@ -5779,7 +5819,7 @@ gfc_array_init_size (tree descriptor, int rank, int
corank, tree * poffset,
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 element_size, bool explicit_ts)
{
tree type;
tree tmp;
@@ -6013,37 +6053,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;
stride = fold_convert (size_type_node, stride);
@@ -6052,14 +6065,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,
@@ -6069,7 +6082,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, element_size);
if (poffset != NULL)
{
@@ -6257
[gcc(refs/users/mikael/heads/refactor_descriptor_v08)] Extraction gfc_shift_descriptor
https://gcc.gnu.org/g:e3f99dc6ce137049a7061d891b21b304ce8b7926
commit e3f99dc6ce137049a7061d891b21b304ce8b7926
Author: Mikael Morin
Date: Wed Jul 23 14:59:35 2025 +0200
Extraction gfc_shift_descriptor
Diff:
---
gcc/fortran/trans-descriptor.cc | 31 +++
gcc/fortran/trans-descriptor.h | 2 ++
gcc/fortran/trans-expr.cc | 39 ++-
3 files changed, 35 insertions(+), 37 deletions(-)
diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index bc7f951bb528..ac426dd9677b 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -2002,3 +2002,34 @@ gfc_set_temporary_descriptor (stmtblock_t *block, tree
descr, tree class_src,
gfc_conv_descriptor_data_set (block, descr, data_ptr);
}
+
+void
+gfc_shift_descriptor (stmtblock_t *block, tree descr, 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 (descr, 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, descr, gfc_rank_cst[n], tmp);
+ gfc_conv_descriptor_lbound_set (block, descr, 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 = fold_build2_loc (input_location, MINUS_EXPR,
+gfc_array_index_type, ubound[n], lbound[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 (block, descr, offset);
+}
diff --git a/gcc/fortran/trans-descriptor.h b/gcc/fortran/trans-descriptor.h
index 0ec506686b93..ccb6d3c048da 100644
--- a/gcc/fortran/trans-descriptor.h
+++ b/gcc/fortran/trans-descriptor.h
@@ -135,5 +135,7 @@ void gfc_copy_descriptor (stmtblock_t *, tree, tree, tree,
int, gfc_ss *);
void gfc_set_temporary_descriptor (stmtblock_t *, tree, tree, tree, tree,
tree [GFC_MAX_DIMENSIONS],
tree [GFC_MAX_DIMENSIONS], int, bool, bool);
+void gfc_shift_descriptor (stmtblock_t *, tree, int, tree [GFC_MAX_DIMENSIONS],
+ tree [GFC_MAX_DIMENSIONS]);
#endif /* GFC_TRANS_DESCRIPTOR_H */
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index b9c8e8748f59..d73ecc08842b 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -5386,7 +5386,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;
@@ -5627,42 +5626,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
[gcc(refs/users/mikael/heads/refactor_descriptor_v08)] Extraction gfc_set_descriptor_from_scalar
https://gcc.gnu.org/g:c7a06506e9a846bbdf0a67366f3afb9b87321b29
commit c7a06506e9a846bbdf0a67366f3afb9b87321b29
Author: Mikael Morin
Date: Tue Jul 22 21:03:11 2025 +0200
Extraction gfc_set_descriptor_from_scalar
Diff:
---
gcc/fortran/trans-descriptor.cc | 20
gcc/fortran/trans-descriptor.h | 2 ++
gcc/fortran/trans-expr.cc | 16 ++--
3 files changed, 24 insertions(+), 14 deletions(-)
diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index 6995eb1da052..cef609e0464b 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -1882,3 +1882,23 @@ gfc_set_descriptor_from_scalar (stmtblock_t *block, tree
descr,
gfc_conv_descriptor_data_set (block, descr, tmp);
}
+
+void
+gfc_set_descriptor_from_scalar (stmtblock_t *block, tree descr,
+ tree scalar, gfc_expr *scalar_expr,
+ tree cond_presence)
+{
+ tree type;
+ type = gfc_get_scalar_to_descriptor_type (scalar,
+ gfc_expr_attr (scalar_expr));
+ gfc_conv_descriptor_dtype_set (block, descr,
+gfc_get_dtype (type));
+ if (cond_presence)
+scalar = build3_loc (input_location, COND_EXPR,
+TREE_TYPE (scalar),
+cond_presence, scalar,
+fold_convert (TREE_TYPE (scalar),
+ null_pointer_node));
+ gfc_conv_descriptor_data_set (block, descr, scalar);
+}
+
diff --git a/gcc/fortran/trans-descriptor.h b/gcc/fortran/trans-descriptor.h
index 0e87eee39b38..32b045ac8c1b 100644
--- a/gcc/fortran/trans-descriptor.h
+++ b/gcc/fortran/trans-descriptor.h
@@ -128,5 +128,7 @@ void gfc_set_gfc_from_cfi (stmtblock_t *, tree, gfc_expr *,
tree, tree,
void gfc_set_gfc_from_cfi (stmtblock_t *, stmtblock_t *, tree, tree, tree,
gfc_symbol *, bool);
void gfc_set_descriptor_from_scalar (stmtblock_t *, tree, tree, gfc_expr *);
+void gfc_set_descriptor_from_scalar (stmtblock_t *, tree, tree, gfc_expr *,
+tree);
#endif /* GFC_TRANS_DESCRIPTOR_H */
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 95465cec1c02..e0115c953de0 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -959,20 +959,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)
- {
- tree type;
- type = gfc_get_scalar_to_descriptor_type (parmse->expr,
- gfc_expr_attr (e));
- gfc_conv_descriptor_dtype_set (&parmse->pre, 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);
- }
+ gfc_set_descriptor_from_scalar (&parmse->pre, ctree,
+ parmse->expr, e, cond_optional);
else
{
tmp = fold_convert (TREE_TYPE (ctree), parmse->expr);
[gcc(refs/users/mikael/heads/refactor_descriptor_v08)] Suppression modif offset trans_associate_var
https://gcc.gnu.org/g:8ce0ef69c547a5319161824f936cfdcf735a6fdd
commit 8ce0ef69c547a5319161824f936cfdcf735a6fdd
Author: Mikael Morin
Date: Mon Feb 17 14:43:06 2025 +0100
Suppression modif offset trans_associate_var
Correction bootstrap suppression variables inutilisées
Diff:
---
gcc/fortran/trans-stmt.cc | 18 --
1 file changed, 18 deletions(-)
diff --git a/gcc/fortran/trans-stmt.cc b/gcc/fortran/trans-stmt.cc
index ddd0a120229c..edfed1d264bc 100644
--- a/gcc/fortran/trans-stmt.cc
+++ b/gcc/fortran/trans-stmt.cc
@@ -1877,9 +1877,6 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block
*block)
bool class_target;
bool unlimited;
tree desc;
- tree offset;
- tree dim;
- int n;
tree charlen;
bool need_len_assign;
bool whole_array = true;
@@ -2299,21 +2296,6 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block
*block)
desc = gfc_class_data_get (se.expr);
- /* Set the offset. */
- offset = gfc_index_zero_node;
- for (n = 0; n < e->rank; n++)
- {
- dim = gfc_rank_cst[n];
- tmp = fold_build2_loc (input_location, MULT_EXPR,
-gfc_array_index_type,
-gfc_conv_descriptor_stride_get (desc, dim),
-gfc_conv_descriptor_lbound_get (desc,
dim));
- offset = fold_build2_loc (input_location, MINUS_EXPR,
- gfc_array_index_type,
- offset, tmp);
- }
- gfc_conv_descriptor_offset_set (&se.pre, desc, offset);
-
if (need_len_assign)
{
if (e->symtree
[gcc(refs/users/mikael/heads/refactor_descriptor_v08)] Renseignement token dans gcf_set_descriptor_from_scalar
https://gcc.gnu.org/g:7b804313aa7b237746191fc7f8e448466d7e6c86
commit 7b804313aa7b237746191fc7f8e448466d7e6c86
Author: Mikael Morin
Date: Wed Jul 23 09:44:49 2025 +0200
Renseignement token dans gcf_set_descriptor_from_scalar
Diff:
---
gcc/fortran/trans-descriptor.cc | 11 +++
gcc/fortran/trans-descriptor.h | 2 +-
gcc/fortran/trans-expr.cc | 16 +++-
3 files changed, 19 insertions(+), 10 deletions(-)
diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index a9469c639ae4..22e5cbed8a65 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -1886,11 +1886,13 @@ gfc_set_descriptor_from_scalar (stmtblock_t *block,
tree descr,
void
gfc_set_descriptor_from_scalar (stmtblock_t *block, tree descr,
tree scalar, gfc_expr *scalar_expr,
- tree cond_presence)
+ tree cond_presence, tree caf_token)
{
- tree type;
- type = gfc_get_scalar_to_descriptor_type (scalar,
- gfc_expr_attr (scalar_expr));
+ if (flag_coarray == GFC_FCOARRAY_LIB && caf_token)
+gfc_conv_descriptor_token_set (block, descr, caf_token);
+
+ tree type = gfc_get_scalar_to_descriptor_type (scalar,
+gfc_expr_attr (scalar_expr));
gfc_conv_descriptor_dtype_set (block, descr,
gfc_get_dtype (type));
if (cond_presence)
@@ -1917,5 +1919,6 @@ gfc_set_descriptor_from_scalar (stmtblock_t *block, tree
descr, tree scalar)
gfc_conv_descriptor_data_set (block, descr, scalar);
gfc_conv_descriptor_span_set (block, descr,
gfc_conv_descriptor_elem_len_get (descr));
+
}
diff --git a/gcc/fortran/trans-descriptor.h b/gcc/fortran/trans-descriptor.h
index 7e6e2871bc5e..b586b9679877 100644
--- a/gcc/fortran/trans-descriptor.h
+++ b/gcc/fortran/trans-descriptor.h
@@ -130,6 +130,6 @@ void gfc_set_gfc_from_cfi (stmtblock_t *, stmtblock_t *,
tree, tree, tree,
void gfc_set_descriptor_from_scalar (stmtblock_t *, tree, tree);
void gfc_set_descriptor_from_scalar (stmtblock_t *, tree, tree, gfc_expr *);
void gfc_set_descriptor_from_scalar (stmtblock_t *, tree, tree, gfc_expr *,
-tree);
+tree, tree);
#endif /* GFC_TRANS_DESCRIPTOR_H */
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 88fda9047eac..b9c8e8748f59 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -864,6 +864,7 @@ gfc_conv_derived_to_class (gfc_se *parmse, gfc_expr *e,
gfc_symbol *fsym,
tree var;
tree tmp;
tree packed = NULL_TREE;
+ tree caf_token = NULL_TREE;
/* The derived type needs to be converted to a temporary CLASS object. */
tmp = gfc_typenode_for_spec (&fsym->ts);
@@ -880,12 +881,17 @@ gfc_conv_derived_to_class (gfc_se *parmse, gfc_expr *e,
gfc_symbol *fsym,
if (flag_coarray == GFC_FCOARRAY_LIB && CLASS_DATA (fsym)->attr.codimension)
{
- tree token;
tmp = gfc_get_tree_for_caf_expr (e);
if (POINTER_TYPE_P (TREE_TYPE (tmp)))
tmp = build_fold_indirect_ref (tmp);
- gfc_get_caf_token_offset (parmse, &token, nullptr, tmp, NULL_TREE, e);
- gfc_conv_descriptor_token_set (&parmse->pre, ctree, token);
+ gfc_get_caf_token_offset (parmse, &caf_token, nullptr, tmp, NULL_TREE,
e);
+ /* Update the token here, unless it's done elsewhere like in
+ gfc_set_descriptor_from_scalar. */
+ if ((parmse->expr && POINTER_TYPE_P (TREE_TYPE (parmse->expr)))
+ || (parmse->ss && parmse->ss->info && parmse->ss->info->useflags)
+ || e->rank != 0
+ || fsym->ts.u.derived->components->as == nullptr)
+ gfc_conv_descriptor_token_set (&parmse->pre, ctree, caf_token);
}
if (optional)
@@ -951,8 +957,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)
- gfc_set_descriptor_from_scalar (&parmse->pre, ctree,
- parmse->expr, e, cond_optional);
+ gfc_set_descriptor_from_scalar (&parmse->pre, ctree, parmse->expr,
+ e, cond_optional, caf_token);
else
{
tmp = fold_convert (TREE_TYPE (ctree), parmse->expr);
[gcc(refs/users/mikael/heads/refactor_descriptor_v08)] Suppression set span dans trans_associate_var
https://gcc.gnu.org/g:050cd4d916f682c1a3aefc6e041c861cd16ec2d3
commit 050cd4d916f682c1a3aefc6e041c861cd16ec2d3
Author: Mikael Morin
Date: Mon Feb 17 16:16:47 2025 +0100
Suppression set span dans trans_associate_var
Diff:
---
gcc/fortran/trans-stmt.cc | 10 --
1 file changed, 10 deletions(-)
diff --git a/gcc/fortran/trans-stmt.cc b/gcc/fortran/trans-stmt.cc
index edfed1d264bc..696d24476152 100644
--- a/gcc/fortran/trans-stmt.cc
+++ b/gcc/fortran/trans-stmt.cc
@@ -2177,16 +2177,6 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block
*block)
gfc_conv_shift_descriptor (&se.pre, desc, e->rank);
}
- /* If this is a subreference array pointer associate name use the
-associate variable element size for the value of 'span'. */
- if (sym->attr.subref_array_pointer && !se.direct_byref)
- {
- gcc_assert (e->expr_type == EXPR_VARIABLE);
- tmp = gfc_get_array_span (se.expr, e);
-
- gfc_conv_descriptor_span_set (&se.pre, desc, tmp);
- }
-
if (e->expr_type == EXPR_FUNCTION
&& sym->ts.type == BT_DERIVED
&& sym->ts.u.derived
[gcc(refs/users/mikael/heads/refactor_descriptor_v08)] Extraction gfc_set_descriptor_for_assign_realloc
https://gcc.gnu.org/g:9a7375ac923271e31f0e98334eaa6547062904bc
commit 9a7375ac923271e31f0e98334eaa6547062904bc
Author: Mikael Morin
Date: Thu Jul 31 12:11:15 2025 +0200
Extraction gfc_set_descriptor_for_assign_realloc
Diff:
---
gcc/fortran/trans-array.cc | 228 ++--
gcc/fortran/trans-array.h | 1 +
gcc/fortran/trans-descriptor.cc | 216 +
gcc/fortran/trans-descriptor.h | 3 +
4 files changed, 226 insertions(+), 222 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 80e3b767ff76..f68a7467f311 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -10557,76 +10557,6 @@ gfc_check_pdt_dummy (gfc_symbol * der_type, tree decl,
int rank,
}
-/* Returns the value of LBOUND for an expression. This could be broken out
- from gfc_conv_intrinsic_bound but this seemed to be simpler. This is
- called by gfc_alloc_allocatable_for_assignment. */
-static tree
-get_std_lbound (gfc_expr *expr, tree desc, int dim, bool assumed_size)
-{
- tree lbound;
- tree ubound;
- tree stride;
- tree cond, cond1, cond3, cond4;
- tree tmp;
- gfc_ref *ref;
-
- if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (desc)))
-{
- tmp = gfc_rank_cst[dim];
- lbound = gfc_conv_descriptor_lbound_get (desc, tmp);
- ubound = gfc_conv_descriptor_ubound_get (desc, tmp);
- stride = gfc_conv_descriptor_stride_get (desc, tmp);
- cond1 = fold_build2_loc (input_location, GE_EXPR, logical_type_node,
- ubound, lbound);
- cond3 = fold_build2_loc (input_location, GE_EXPR, logical_type_node,
- stride, gfc_index_zero_node);
- cond3 = fold_build2_loc (input_location, TRUTH_AND_EXPR,
- logical_type_node, cond3, cond1);
- cond4 = fold_build2_loc (input_location, LT_EXPR, logical_type_node,
- stride, gfc_index_zero_node);
- if (assumed_size)
- cond = fold_build2_loc (input_location, EQ_EXPR, logical_type_node,
- tmp, build_int_cst (gfc_array_index_type,
- expr->rank - 1));
- else
- cond = logical_false_node;
-
- cond1 = fold_build2_loc (input_location, TRUTH_OR_EXPR,
- logical_type_node, cond3, cond4);
- cond = fold_build2_loc (input_location, TRUTH_OR_EXPR,
- logical_type_node, cond, cond1);
-
- return fold_build3_loc (input_location, COND_EXPR,
- gfc_array_index_type, cond,
- lbound, gfc_index_one_node);
-}
-
- if (expr->expr_type == EXPR_FUNCTION)
-{
- /* A conversion function, so use the argument. */
- gcc_assert (expr->value.function.isym
- && expr->value.function.isym->conversion);
- expr = expr->value.function.actual->expr;
-}
-
- if (expr->expr_type == EXPR_VARIABLE)
-{
- tmp = TREE_TYPE (expr->symtree->n.sym->backend_decl);
- for (ref = expr->ref; ref; ref = ref->next)
- {
- if (ref->type == REF_COMPONENT
- && ref->u.c.component->as
- && ref->next
- && ref->next->u.ar.type == AR_FULL)
- tmp = TREE_TYPE (ref->u.c.component->backend_decl);
- }
- return GFC_TYPE_ARRAY_LBOUND(tmp, dim);
-}
-
- return gfc_index_one_node;
-}
-
-
/* Returns true if an expression represents an lhs that can be reallocated
on assignment. */
@@ -10776,8 +10706,8 @@ concat_str_length (gfc_expr* expr)
At the end of the function, the expressions have been replaced with variable
references. */
-static void
-update_reallocated_descriptor (stmtblock_t *block, gfc_loopinfo *loop)
+void
+gfc_update_reallocated_descriptor (stmtblock_t *block, gfc_loopinfo *loop)
{
for (gfc_ss *s = loop->ss; s != gfc_ss_terminator; s = s->loop_chain)
{
@@ -10830,7 +10760,6 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo
*loop,
gfc_array_info *linfo;
tree realloc_expr;
tree alloc_expr;
- tree size1;
tree size2;
tree elemsize1;
tree elemsize2;
@@ -10838,19 +10767,15 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo
*loop,
tree cond_null;
tree cond;
tree tmp;
- tree tmp2;
tree lbound;
tree ubound;
tree desc;
tree old_desc;
tree desc2;
- tree offset;
tree jump_label1;
tree jump_label2;
- tree lbd;
tree class_expr2 = NULL_TREE;
int n;
- gfc_array_spec * as;
bool coarray = (flag_coarray == GFC_FCOARRAY_LIB
&& gfc_caf_attr (expr1, true).codimension);
tree token;
@@ -11076,20 +11001,6 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo
*loop,
build_empty_stmt (input_location));
gfc_add_expr_to_block (&fblock, tmp);
- /* Get arrayspec if expr is a full array. */
- if (expr2 && expr2->expr_type
[gcc(refs/users/mikael/heads/refactor_descriptor_v08)] Extraction get_array_memory_size
https://gcc.gnu.org/g:05877f1396371864d32927500e45fc32955f5b22
commit 05877f1396371864d32927500e45fc32955f5b22
Author: Mikael Morin
Date: Wed Jul 23 22:21:15 2025 +0200
Extraction get_array_memory_size
Diff:
---
gcc/fortran/trans-array.cc | 155 -
1 file changed, 84 insertions(+), 71 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 24f4d9695a0f..f895c3c7e286 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -5782,6 +5782,63 @@ 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)
+{
+ 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. */
+ tree tmp = fold_build2_loc (input_location, TRUNC_DIV_EXPR,
+ size_type_node, TYPE_MAX_VALUE (size_type_node),
+ element_size);
+ tree 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);
+
+ tree 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);
+
+ tree var = gfc_create_var (TREE_TYPE (size), "size");
+
+ stmtblock_t thenblock;
+ gfc_start_block (&thenblock);
+ gfc_add_modify (&thenblock, var, build_int_cst (size_type_node, 0));
+ tree thencase = gfc_finish_block (&thenblock);
+
+ stmtblock_t elseblock;
+ gfc_start_block (&elseblock);
+ gfc_add_modify (&elseblock, var, size);
+ tree 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,
@@ -5814,25 +5871,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, 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;
@@ -5884,7 +5936,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++)
{
@@ -5980,7 +6032,7 @@ gfc_array_init_size (tree descriptor, int rank, int
corank, gfc_expr ** lower,
gfc_rank_cst[n], stride);
/* Calculate size and check whether extent i
[gcc(refs/users/mikael/heads/refactor_descriptor_v08)] Déplacement gfc_grow_array
https://gcc.gnu.org/g:4bfc899aa70c35b0d0fdf84c85463b9c07948f8c
commit 4bfc899aa70c35b0d0fdf84c85463b9c07948f8c
Author: Mikael Morin
Date: Thu Jul 31 14:41:23 2025 +0200
Déplacement gfc_grow_array
Diff:
---
gcc/fortran/trans-array.cc | 37 -
gcc/fortran/trans-descriptor.cc | 39 +++
gcc/fortran/trans-descriptor.h | 1 +
3 files changed, 40 insertions(+), 37 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index e1e63caa8e13..bb61a3bdc953 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -1309,43 +1309,6 @@ gfc_get_iteration_count (tree start, tree end, tree step)
}
-/* Extend the data in array DESC by EXTRA elements. */
-
-static void
-gfc_grow_array (stmtblock_t * pblock, tree desc, tree extra)
-{
- tree arg0, arg1;
- tree tmp;
- tree size;
- tree ubound;
-
- if (integer_zerop (extra))
-return;
-
- ubound = gfc_conv_descriptor_ubound_get (desc, gfc_rank_cst[0]);
-
- /* Add EXTRA to the upper bound. */
- tmp = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
-ubound, extra);
- gfc_conv_descriptor_ubound_set (pblock, desc, gfc_rank_cst[0], tmp);
-
- /* Get the value of the current data pointer. */
- arg0 = gfc_conv_descriptor_data_get (desc);
-
- /* Calculate the new array size. */
- size = TYPE_SIZE_UNIT (gfc_get_element_type (TREE_TYPE (desc)));
- tmp = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
-ubound, gfc_index_one_node);
- arg1 = fold_build2_loc (input_location, MULT_EXPR, size_type_node,
- fold_convert (size_type_node, tmp),
- fold_convert (size_type_node, size));
-
- /* Call the realloc() function. */
- tmp = gfc_call_realloc (pblock, arg0, arg1);
- gfc_conv_descriptor_data_set (pblock, desc, tmp);
-}
-
-
/* Return true if the bounds of iterator I can only be determined
at run time. */
diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index 8ef357bd5196..ff35e7cca670 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -2329,3 +2329,42 @@ gfc_set_pdt_array_descriptor (stmtblock_t *block, tree
descr,
return size;
}
+
+
+/* Extend the data in array DESC by EXTRA elements. */
+
+void
+gfc_grow_array (stmtblock_t * pblock, tree desc, tree extra)
+{
+ tree arg0, arg1;
+ tree tmp;
+ tree size;
+ tree ubound;
+
+ if (integer_zerop (extra))
+return;
+
+ ubound = gfc_conv_descriptor_ubound_get (desc, gfc_rank_cst[0]);
+
+ /* Add EXTRA to the upper bound. */
+ tmp = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
+ubound, extra);
+ gfc_conv_descriptor_ubound_set (pblock, desc, gfc_rank_cst[0], tmp);
+
+ /* Get the value of the current data pointer. */
+ arg0 = gfc_conv_descriptor_data_get (desc);
+
+ /* Calculate the new array size. */
+ size = TYPE_SIZE_UNIT (gfc_get_element_type (TREE_TYPE (desc)));
+ tmp = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
+ubound, gfc_index_one_node);
+ arg1 = fold_build2_loc (input_location, MULT_EXPR, size_type_node,
+ fold_convert (size_type_node, tmp),
+ fold_convert (size_type_node, size));
+
+ /* Call the realloc() function. */
+ tmp = gfc_call_realloc (pblock, arg0, arg1);
+ gfc_conv_descriptor_data_set (pblock, desc, tmp);
+}
+
+
diff --git a/gcc/fortran/trans-descriptor.h b/gcc/fortran/trans-descriptor.h
index 4f12abe5f544..27a700ccc1df 100644
--- a/gcc/fortran/trans-descriptor.h
+++ b/gcc/fortran/trans-descriptor.h
@@ -144,5 +144,6 @@ void gfc_set_descriptor_for_assign_realloc (stmtblock_t *,
gfc_loopinfo *,
tree, tree, bool);
tree gfc_set_pdt_array_descriptor (stmtblock_t *, tree, gfc_array_spec *,
gfc_actual_arglist *, tree);
+void gfc_grow_array (stmtblock_t *, tree, tree);
#endif /* GFC_TRANS_DESCRIPTOR_H */
[gcc(refs/users/mikael/heads/refactor_descriptor_v08)] Essai suppression initialisation span dans gfc_conv_expr_descriptor
https://gcc.gnu.org/g:bc40798c693403b586d3308c1275b6401502ddd0
commit bc40798c693403b586d3308c1275b6401502ddd0
Author: Mikael Morin
Date: Mon Mar 17 19:26:09 2025 +0100
Essai suppression initialisation span dans gfc_conv_expr_descriptor
Diff:
---
gcc/fortran/trans-array.cc | 8
1 file changed, 8 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 9a66f722e157..647a8d814b71 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -7883,14 +7883,6 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr)
else
gcc_assert (se->ss == ss);
- if (!is_pointer_array (se->expr))
- {
- tmp = gfc_get_element_type (TREE_TYPE (se->expr));
- tmp = fold_convert (gfc_array_index_type,
- size_in_bytes (tmp));
- gfc_conv_descriptor_span_set (&se->pre, se->expr, tmp);
- }
-
se->expr = gfc_build_addr_expr (NULL_TREE, se->expr);
gfc_conv_expr (se, expr);
[gcc(refs/users/mikael/heads/refactor_descriptor_v08)] Suppression mise à jour upper bound.
https://gcc.gnu.org/g:0b6cbdff0ab2ff35667481f03ca856815a96a831 commit 0b6cbdff0ab2ff35667481f03ca856815a96a831 Author: Mikael Morin Date: Mon Mar 17 19:09:18 2025 +0100 Suppression mise à jour upper bound. Diff: --- gcc/fortran/trans-array.cc | 1 - 1 file changed, 1 deletion(-) diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc index bb61a3bdc953..9a66f722e157 100644 --- a/gcc/fortran/trans-array.cc +++ b/gcc/fortran/trans-array.cc @@ -2546,7 +2546,6 @@ trans_array_constructor (gfc_ss * ss, locus * where) gfc_array_index_type, offsetvar, gfc_index_one_node); tmp = gfc_evaluate_now (tmp, &outer_loop->pre); - gfc_conv_descriptor_ubound_set (&loop->pre, desc, gfc_rank_cst[0], tmp); if (*loop_ubound0 && VAR_P (*loop_ubound0)) gfc_add_modify (&outer_loop->pre, *loop_ubound0, tmp); else
[gcc(refs/users/mikael/heads/refactor_descriptor_v08)] Extraction gfc_set_pdt_array_descriptor
https://gcc.gnu.org/g:ab2bc5528e83490eb7afaf841f88ce754f265e4d
commit ab2bc5528e83490eb7afaf841f88ce754f265e4d
Author: Mikael Morin
Date: Thu Jul 31 12:34:22 2025 +0200
Extraction gfc_set_pdt_array_descriptor
Diff:
---
gcc/fortran/trans-array.cc | 62 +
gcc/fortran/trans-descriptor.cc | 49
gcc/fortran/trans-descriptor.h | 2 ++
3 files changed, 58 insertions(+), 55 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index f68a7467f311..09f60e745e20 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -10140,56 +10140,9 @@ structure_alloc_comps (gfc_symbol * der_type, tree
decl, tree dest,
if (c->attr.pdt_array)
{
- gfc_se tse;
- int i;
- tree size = gfc_index_one_node;
- tree offset = gfc_index_zero_node;
- tree lower, upper;
- gfc_expr *e;
-
- /* This chunk takes the expressions for 'lower' and 'upper'
-in the arrayspec and substitutes in the expressions for
-the parameters from 'pdt_param_list'. The descriptor
-fields can then be filled from the values so obtained. */
- gcc_assert (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (comp)));
- for (i = 0; i < c->as->rank; i++)
- {
- gfc_init_se (&tse, NULL);
- e = gfc_copy_expr (c->as->lower[i]);
- gfc_insert_parameter_exprs (e, pdt_param_list);
- gfc_conv_expr_type (&tse, e, gfc_array_index_type);
- gfc_free_expr (e);
- lower = tse.expr;
- gfc_conv_descriptor_lbound_set (&fnblock, comp,
- gfc_rank_cst[i],
- lower);
- e = gfc_copy_expr (c->as->upper[i]);
- gfc_insert_parameter_exprs (e, pdt_param_list);
- gfc_conv_expr_type (&tse, e, gfc_array_index_type);
- gfc_free_expr (e);
- upper = tse.expr;
- gfc_conv_descriptor_ubound_set (&fnblock, comp,
- gfc_rank_cst[i],
- upper);
- gfc_conv_descriptor_stride_set (&fnblock, comp,
- gfc_rank_cst[i],
- size);
- size = gfc_evaluate_now (size, &fnblock);
- offset = fold_build2_loc (input_location,
- MINUS_EXPR,
- gfc_array_index_type,
- offset, size);
- offset = gfc_evaluate_now (offset, &fnblock);
- tmp = fold_build2_loc (input_location, MINUS_EXPR,
-gfc_array_index_type,
-upper, lower);
- 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 (&fnblock, comp, offset);
+ tree nelts = gfc_set_pdt_array_descriptor (&fnblock, comp, c->as,
+pdt_param_list);
+
if (c->ts.type == BT_CLASS)
{
tmp = gfc_get_vptr_from_expr (comp);
@@ -10200,18 +10153,17 @@ structure_alloc_comps (gfc_symbol * der_type, tree
decl, tree dest,
else
tmp = TYPE_SIZE_UNIT (gfc_get_element_type (ctype));
tmp = fold_convert (gfc_array_index_type, tmp);
- size = fold_build2_loc (input_location, MULT_EXPR,
- gfc_array_index_type, size, tmp);
+ tree size = fold_build2_loc (input_location, MULT_EXPR,
+ gfc_array_index_type, nelts, tmp);
size = gfc_evaluate_now (size, &fnblock);
tmp = gfc_call_malloc (&fnblock, NULL, size);
gfc_conv_descriptor_data_set (&fnblock, comp, tmp);
- gfc_conv_descriptor_dtype_set (&fnblock, comp,
-gfc_get_dtype (ctype));
if (c->initializer && c->initializer->rank)
{
+ gfc_se tse;
gfc_init_se (&tse, NULL);
- e = gfc_copy_expr (c->initializer);
+ gfc_expr *e = gfc_copy_expr (c->initializer);
gfc_insert_parameter_exprs (e, pdt_param_list
[gcc(refs/users/mikael/heads/refactor_descriptor_v08)] Déplacemement plus de code gfc_set_pdt_array_descriptor
https://gcc.gnu.org/g:c41ded73c1423a598fc1ec2cd8b6a5495f0651c7
commit c41ded73c1423a598fc1ec2cd8b6a5495f0651c7
Author: Mikael Morin
Date: Thu Jul 31 15:19:35 2025 +0200
Déplacemement plus de code gfc_set_pdt_array_descriptor
Diff:
---
gcc/fortran/trans-array.cc | 19 ---
gcc/fortran/trans-descriptor.cc | 8 +++-
gcc/fortran/trans-descriptor.h | 2 +-
3 files changed, 16 insertions(+), 13 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 09f60e745e20..e1e63caa8e13 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -10140,24 +10140,21 @@ structure_alloc_comps (gfc_symbol * der_type, tree
decl, tree dest,
if (c->attr.pdt_array)
{
- tree nelts = gfc_set_pdt_array_descriptor (&fnblock, comp, c->as,
-pdt_param_list);
-
+ tree elt_size;
if (c->ts.type == BT_CLASS)
{
tmp = gfc_get_vptr_from_expr (comp);
if (POINTER_TYPE_P (TREE_TYPE (tmp)))
tmp = build_fold_indirect_ref_loc (input_location, tmp);
- tmp = gfc_vptr_size_get (tmp);
+ elt_size = gfc_vptr_size_get (tmp);
}
else
- tmp = TYPE_SIZE_UNIT (gfc_get_element_type (ctype));
- tmp = fold_convert (gfc_array_index_type, tmp);
- tree size = fold_build2_loc (input_location, MULT_EXPR,
- gfc_array_index_type, nelts, tmp);
- size = gfc_evaluate_now (size, &fnblock);
- tmp = gfc_call_malloc (&fnblock, NULL, size);
- gfc_conv_descriptor_data_set (&fnblock, comp, tmp);
+ elt_size = TYPE_SIZE_UNIT (gfc_get_element_type (ctype));
+ elt_size = fold_convert (gfc_array_index_type, elt_size);
+
+ tree size = gfc_set_pdt_array_descriptor (&fnblock, comp, c->as,
+ pdt_param_list,
+ elt_size);
if (c->initializer && c->initializer->rank)
{
diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index 01fda43a0027..8ef357bd5196 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -2278,7 +2278,7 @@ gfc_set_descriptor_for_assign_realloc (stmtblock_t
*block, gfc_loopinfo *loop,
tree
gfc_set_pdt_array_descriptor (stmtblock_t *block, tree descr,
gfc_array_spec *as,
- gfc_actual_arglist *pdt_param_list)
+ gfc_actual_arglist *pdt_param_list, tree elt_size)
{
gfc_se tse;
tree size = gfc_index_one_node;
@@ -2321,5 +2321,11 @@ gfc_set_pdt_array_descriptor (stmtblock_t *block, tree
descr,
gfc_conv_descriptor_dtype_set (block, descr,
gfc_get_dtype (TREE_TYPE (descr)));
+ size = fold_build2_loc (input_location, MULT_EXPR,
+ gfc_array_index_type, size, elt_size);
+ size = gfc_evaluate_now (size, block);
+ gfc_conv_descriptor_data_set (block, descr,
+ gfc_call_malloc (block, NULL, size));
+
return size;
}
diff --git a/gcc/fortran/trans-descriptor.h b/gcc/fortran/trans-descriptor.h
index 7c14862bd76d..4f12abe5f544 100644
--- a/gcc/fortran/trans-descriptor.h
+++ b/gcc/fortran/trans-descriptor.h
@@ -143,6 +143,6 @@ void gfc_set_descriptor_for_assign_realloc (stmtblock_t *,
gfc_loopinfo *,
gfc_expr *, gfc_expr *, tree, tree,
tree, tree, bool);
tree gfc_set_pdt_array_descriptor (stmtblock_t *, tree, gfc_array_spec *,
- gfc_actual_arglist *);
+ gfc_actual_arglist *, tree);
#endif /* GFC_TRANS_DESCRIPTOR_H */
[gcc(refs/users/mikael/heads/refactor_descriptor_v08)] Extraction gfc_copy_descriptor
https://gcc.gnu.org/g:b31ddda1320f33a3ee439c3fd493fe37f8efc4d8
commit b31ddda1320f33a3ee439c3fd493fe37f8efc4d8
Author: Mikael Morin
Date: Wed Jul 23 10:48:32 2025 +0200
Extraction gfc_copy_descriptor
Diff:
---
gcc/fortran/trans-array.cc | 39 +++
gcc/fortran/trans-array.h | 2 ++
gcc/fortran/trans-descriptor.cc | 26 ++
gcc/fortran/trans-descriptor.h | 1 +
4 files changed, 36 insertions(+), 32 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 28dee67e8154..807de4f8ae32 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -788,8 +788,8 @@ innermost_ss (gfc_ss *ss)
It is different from the loop dimension in the case of a transposed array.
*/
-static int
-get_array_ref_dim_for_loop_dim (gfc_ss *ss, int loop_dim)
+int
+gfc_get_array_ref_dim_for_loop_dim (gfc_ss *ss, int loop_dim)
{
return get_scalarizer_dim_for_array_dim (innermost_ss (ss),
ss->dim[loop_dim]);
@@ -2361,7 +2361,7 @@ get_loop_upper_bound_for_array (gfc_ss *array, int
array_dim)
for (ss = array; ss; ss = ss->parent)
for (n = 0; n < ss->loop->dimen; n++)
- if (array_dim == get_array_ref_dim_for_loop_dim (ss, n))
+ if (array_dim == gfc_get_array_ref_dim_for_loop_dim (ss, n))
return &(ss->loop->to[n]);
gcc_unreachable ();
@@ -5478,7 +5478,8 @@ set_loop_bounds (gfc_loopinfo *loop)
&& INTEGER_CST_P (info->stride[dim]))
{
loop->from[n] = info->start[dim];
- mpz_set (i, cshape[get_array_ref_dim_for_loop_dim (loopspec[n], n)]);
+ int idx = gfc_get_array_ref_dim_for_loop_dim (loopspec[n], n);
+ mpz_set (i, cshape[idx]);
mpz_sub_ui (i, i, 1);
/* To = from + (size - 1) * stride. */
tmp = gfc_conv_mpz_to_tree (i, gfc_index_integer_kind);
@@ -8801,39 +8802,13 @@ gfc_conv_array_parameter (gfc_se *se, gfc_expr *expr,
bool g77,
}
else if (!ctree)
{
- tree old_field;
-
/* The original descriptor has transposed dims so we can't reuse
it directly; we have to create a new one. */
tree old_desc = tmp;
tree new_desc = gfc_create_var (TREE_TYPE (old_desc), "arg_desc");
- old_field = gfc_conv_descriptor_dtype_get (old_desc);
- gfc_conv_descriptor_dtype_set (&se->pre, new_desc, old_field);
-
- old_field = gfc_conv_descriptor_offset_get (old_desc);
- gfc_conv_descriptor_offset_set (&se->pre, new_desc, old_field);
-
- for (int i = 0; i < expr->rank; i++)
- {
- int idx = get_array_ref_dim_for_loop_dim (ss, i);
- old_field = gfc_conv_descriptor_dimension_get (old_desc, idx);
- gfc_conv_descriptor_dimension_set (&se->pre, new_desc, i,
-old_field);
-
- }
-
- if (flag_coarray == GFC_FCOARRAY_LIB
- && GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (old_desc))
- && GFC_TYPE_ARRAY_AKIND (TREE_TYPE (old_desc))
-== GFC_ARRAY_ALLOCATABLE)
- {
- old_field = gfc_conv_descriptor_token (old_desc);
- gfc_conv_descriptor_token_set (&se->pre, new_desc,
-old_field);
- }
-
- gfc_conv_descriptor_data_set (&se->pre, new_desc, ptr);
+ gfc_copy_descriptor (&se->pre, new_desc, old_desc, ptr,
+ expr->rank, ss);
se->expr = gfc_build_addr_expr (NULL_TREE, new_desc);
}
gfc_free_ss (ss);
diff --git a/gcc/fortran/trans-array.h b/gcc/fortran/trans-array.h
index 1d737fc2efa9..66e11d9d1f16 100644
--- a/gcc/fortran/trans-array.h
+++ b/gcc/fortran/trans-array.h
@@ -189,3 +189,5 @@ void gfc_trans_string_copy (stmtblock_t *, tree, tree, int,
tree, tree, int);
/* Calculate extent / size of an array. */
tree gfc_conv_array_extent_dim (tree, tree, tree*);
+int gfc_get_array_ref_dim_for_loop_dim (gfc_ss *, int);
+
diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index 22e5cbed8a65..b36ec15f5fda 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -1922,3 +1922,29 @@ gfc_set_descriptor_from_scalar (stmtblock_t *block, tree
descr, tree scalar)
}
+
+void
+gfc_copy_descriptor (stmtblock_t *block, tree dest, tree src, tree ptr,
+int rank, gfc_ss *ss)
+{
+ gfc_conv_descriptor_dtype_set (block, dest,
+gfc_conv_descriptor_dtype_get (src));
+
+ gfc_conv_descriptor_offset_set (block, dest,
+ gfc_conv_descriptor_offset_get (src));
+
+ for (int i = 0; i < rank;
[gcc r16-2670] tree-optimization/121323 - UBSAN error in ao_ref_init_from_ptr_and_range
https://gcc.gnu.org/g:0be8ffbc854410b65d45a72e843dc18b13fc7b0f
commit r16-2670-g0be8ffbc854410b65d45a72e843dc18b13fc7b0f
Author: Richard Biener
Date: Thu Jul 31 13:04:49 2025 +0200
tree-optimization/121323 - UBSAN error in ao_ref_init_from_ptr_and_range
We should check the offset fits a HWI when multiplied to be in bits.
PR tree-optimization/121323
* tree-ssa-alias.cc (ao_ref_init_from_ptr_and_range): Check
the pointer offset fits in a HWI when represented in bits.
Diff:
---
gcc/tree-ssa-alias.cc | 4 +++-
1 file changed, 3 insertions(+), 1 deletion(-)
diff --git a/gcc/tree-ssa-alias.cc b/gcc/tree-ssa-alias.cc
index 41193432cc10..9b028e040460 100644
--- a/gcc/tree-ssa-alias.cc
+++ b/gcc/tree-ssa-alias.cc
@@ -901,7 +901,9 @@ ao_ref_init_from_ptr_and_range (ao_ref *ref, tree ptr,
if (TREE_CODE (ptr) == ADDR_EXPR)
{
ref->base = get_addr_base_and_unit_offset (TREE_OPERAND (ptr, 0), &t);
- if (ref->base)
+ if (ref->base
+ && coeffs_in_range_p (t, -HOST_WIDE_INT_MAX / BITS_PER_UNIT,
+ HOST_WIDE_INT_MAX / BITS_PER_UNIT))
ref->offset = BITS_PER_UNIT * t;
else
{
[gcc r16-2671] tree-optimization/121320 - UBSAN error in ao_ref_init_from_vn_reference
https://gcc.gnu.org/g:ff6f7d8e005ae94ffd55f1dba727e28531c3daf3 commit r16-2671-gff6f7d8e005ae94ffd55f1dba727e28531c3daf3 Author: Richard Biener Date: Thu Jul 31 13:06:36 2025 +0200 tree-optimization/121320 - UBSAN error in ao_ref_init_from_vn_reference The multiplication by BITS_PER_UNIT should be done in poly_offset_int. PR tree-optimization/121320 * tree-ssa-sccvn.cc (ao_ref_init_from_vn_reference): Convert op->off to poly_offset_int before multiplying by BITS_PER_UNIT. Diff: --- gcc/tree-ssa-sccvn.cc | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/gcc/tree-ssa-sccvn.cc b/gcc/tree-ssa-sccvn.cc index 45fb79cd8a1f..a3117dacb969 100644 --- a/gcc/tree-ssa-sccvn.cc +++ b/gcc/tree-ssa-sccvn.cc @@ -1219,7 +1219,7 @@ ao_ref_init_from_vn_reference (ao_ref *ref, offset = 0; } else - offset += pop->off * BITS_PER_UNIT; + offset += poly_offset_int (pop->off) * BITS_PER_UNIT; op0_p = NULL; break; } @@ -1270,7 +1270,7 @@ ao_ref_init_from_vn_reference (ao_ref *ref, if (maybe_eq (op->off, -1)) max_size = -1; else - offset += op->off * BITS_PER_UNIT; + offset += poly_offset_int (op->off) * BITS_PER_UNIT; break; case REALPART_EXPR:
[gcc(refs/users/mikael/heads/refactor_descriptor_v08)] Essai suppression initialisation span dans gfc_conv_expr_descriptor
https://gcc.gnu.org/g:5183a4c18eae77a885758e0448ccae6dcc8e3009
commit 5183a4c18eae77a885758e0448ccae6dcc8e3009
Author: Mikael Morin
Date: Mon Mar 17 19:26:09 2025 +0100
Essai suppression initialisation span dans gfc_conv_expr_descriptor
Diff:
---
gcc/fortran/trans-array.cc | 8
1 file changed, 8 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index cfec8571a35e..21df91ad4b83 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -7883,14 +7883,6 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr)
else
gcc_assert (se->ss == ss);
- if (!is_pointer_array (se->expr))
- {
- tmp = gfc_get_element_type (TREE_TYPE (se->expr));
- tmp = fold_convert (gfc_array_index_type,
- size_in_bytes (tmp));
- gfc_conv_descriptor_span_set (&se->pre, se->expr, tmp);
- }
-
se->expr = gfc_build_addr_expr (NULL_TREE, se->expr);
gfc_conv_expr (se, expr);
[gcc(refs/users/mikael/heads/refactor_descriptor_v08)] Suppression initialisation span pour les pointeurs
https://gcc.gnu.org/g:08c7492062f8e2c0453103232feaef5a7320c715
commit 08c7492062f8e2c0453103232feaef5a7320c715
Author: Mikael Morin
Date: Tue Jul 15 19:19:24 2025 +0200
Suppression initialisation span pour les pointeurs
Diff:
---
gcc/fortran/trans-decl.cc | 14 --
1 file changed, 14 deletions(-)
diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc
index 1bf1a9a76acb..e5e813e551ca 100644
--- a/gcc/fortran/trans-decl.cc
+++ b/gcc/fortran/trans-decl.cc
@@ -4936,20 +4936,6 @@ 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,
- build_int_cst (gfc_array_index_type, 0));
- gfc_add_init_cleanup (block, gfc_finish_block (&tmpblock),
- NULL_TREE);
- }
-
if (sym->ts.type == BT_CLASS
&& (sym->attr.save || flag_max_stack_var_size == 0)
&& CLASS_DATA (sym)->attr.allocatable)
[gcc(refs/users/mikael/heads/refactor_descriptor_v08)] Suppression gfc_conv_descriptor_type compil' OK
https://gcc.gnu.org/g:c60fef7603595e39d97e514850b6065a2623580e commit c60fef7603595e39d97e514850b6065a2623580e Author: Mikael Morin Date: Sun Jun 29 14:11:50 2025 +0200 Suppression gfc_conv_descriptor_type compil' OK Correction régression PR97046 Suppression non_lvalue type_get Ajout location set_type Diff: --- gcc/fortran/trans-decl.cc | 23 - gcc/fortran/trans-descriptor.cc | 71 +++-- gcc/fortran/trans-descriptor.h | 5 ++- gcc/fortran/trans-expr.cc | 2 +- 4 files changed, 80 insertions(+), 21 deletions(-) diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc index befdf2c46063..bbe65e342a0e 100644 --- a/gcc/fortran/trans-decl.cc +++ b/gcc/fortran/trans-decl.cc @@ -7297,25 +7297,20 @@ gfc_conv_cfi_to_gfc (stmtblock_t *init, stmtblock_t *finally, 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)); + tmp = gfc_conv_descriptor_type_set (gfc_desc, BT_VOID); + tmp2 = gfc_conv_descriptor_type_set (gfc_desc, 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)); + tmp = gfc_conv_descriptor_type_set (gfc_desc, BT_DERIVED); tmp2 = fold_build3_loc (input_location, COND_EXPR, void_type_node, cond, tmp, tmp2); /* if (CFI_type_Character) BT_CHARACTER else < tmp2 > */ @@ -7324,8 +7319,7 @@ gfc_conv_cfi_to_gfc (stmtblock_t *init, stmtblock_t *finally, 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)); + tmp = gfc_conv_descriptor_type_set (gfc_desc, 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 > */ @@ -7337,16 +7331,14 @@ gfc_conv_cfi_to_gfc (stmtblock_t *init, stmtblock_t *finally, 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)); + tmp = gfc_conv_descriptor_type_set (gfc_desc, BT_CHARACTER); tmp2 = fold_build3_loc (input_location, COND_EXPR, void_type_node, cond, tmp, 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)); + tmp = gfc_conv_descriptor_type_set (gfc_desc, BT_COMPLEX); tmp2 = fold_build3_loc (input_location, COND_EXPR, void_type_node, cond, tmp, tmp2); /* if (CFI_type_Integer || CFI_type_Logical || CFI_type_Real) @@ -7364,8 +7356,7 @@ gfc_conv_cfi_to_gfc (stmtblock_t *init, stmtblock_t *finally, CFI_type_Real)); cond = fold_build2_loc (input_location, TRUTH_OR_EXPR, boolean_type_node,
[gcc(refs/users/mikael/heads/refactor_descriptor_v08)] Suppression gfc_conv_descriptor_dtype compil' OK
https://gcc.gnu.org/g:7226384c4fd1ca8b443fe697ee70102861217ad4
commit 7226384c4fd1ca8b443fe697ee70102861217ad4
Author: Mikael Morin
Date: Sat Jun 28 23:09:22 2025 +0200
Suppression gfc_conv_descriptor_dtype compil' OK
Suppression non_lvalue dtype_get
Ajout location descriptor_dtype_set
Suppression variable inutilisée
Suppression retour à la ligne inutile dtype_set
Diff:
---
gcc/fortran/trans-array.cc | 98 +
gcc/fortran/trans-decl.cc | 6 ++-
gcc/fortran/trans-descriptor.cc | 30 ++---
gcc/fortran/trans-descriptor.h | 4 +-
gcc/fortran/trans-expr.cc | 36 +++
gcc/fortran/trans-intrinsic.cc | 11 ++---
gcc/fortran/trans-stmt.cc | 5 +--
7 files changed, 92 insertions(+), 98 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 5fb7db1c0a91..00a0c4c451b5 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -1180,9 +1180,10 @@ gfc_trans_create_temp_array (stmtblock_t * pre,
stmtblock_t * post, gfc_ss * ss,
if (rank_changer)
{
/* Take the dtype from the class expression. */
- dtype = gfc_conv_descriptor_dtype (gfc_class_data_get (class_expr));
- tmp = gfc_conv_descriptor_dtype (desc);
- gfc_add_modify (pre, tmp, dtype);
+ tree class_descr = gfc_class_data_get (class_expr);
+ dtype = gfc_conv_descriptor_dtype_get (class_descr);
+ gfc_conv_descriptor_dtype_set (pre, desc, dtype);
+
/* These transformational functions change the rank. */
tmp = gfc_conv_descriptor_rank (desc);
@@ -1204,8 +1205,8 @@ gfc_trans_create_temp_array (stmtblock_t * pre,
stmtblock_t * post, gfc_ss * ss,
else
{
/* Fill in the array dtype. */
- tmp = gfc_conv_descriptor_dtype (desc);
- gfc_add_modify (pre, tmp, gfc_get_dtype (TREE_TYPE (desc)));
+ gfc_conv_descriptor_dtype_set (pre, desc,
+gfc_get_dtype (TREE_TYPE (desc)));
}
info->descriptor = desc;
@@ -5893,8 +5894,8 @@ gfc_array_init_size (tree descriptor, int rank, int
corank, tree * poffset,
&& VAR_P (expr->ts.u.cl->backend_decl))
{
type = gfc_typenode_for_spec (&expr->ts);
- tmp = gfc_conv_descriptor_dtype (descriptor);
- gfc_add_modify (pblock, tmp, gfc_get_dtype_rank_type (rank, type));
+ gfc_conv_descriptor_dtype_set (pblock, descriptor,
+gfc_get_dtype_rank_type (rank, type));
}
else if (expr->ts.type == BT_CHARACTER
&& expr->ts.deferred
@@ -5915,14 +5916,12 @@ gfc_array_init_size (tree descriptor, int rank, int
corank, tree * poffset,
TREE_OPERAND (descriptor, 0), tmp, NULL_TREE);
tmp = fold_convert (gfc_charlen_type_node, tmp);
type = gfc_get_character_type_len (expr->ts.kind, tmp);
- tmp = gfc_conv_descriptor_dtype (descriptor);
- gfc_add_modify (pblock, tmp, gfc_get_dtype_rank_type (rank, type));
+ gfc_conv_descriptor_dtype_set (pblock, descriptor,
+gfc_get_dtype_rank_type (rank, type));
}
else if (expr3_desc && GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (expr3_desc)))
-{
- tmp = gfc_conv_descriptor_dtype (descriptor);
- gfc_add_modify (pblock, tmp, gfc_conv_descriptor_dtype (expr3_desc));
-}
+gfc_conv_descriptor_dtype_set (pblock, descriptor,
+ gfc_conv_descriptor_dtype_get (expr3_desc));
else if (expr->ts.type == BT_CLASS && !explicit_ts
&& expr3 && expr3->ts.type != BT_CLASS
&& expr3_elem_size != NULL_TREE && expr3_desc == NULL_TREE)
@@ -5932,10 +5931,7 @@ gfc_array_init_size (tree descriptor, int rank, int
corank, tree * poffset,
fold_convert (TREE_TYPE (tmp), expr3_elem_size));
}
else
-{
- tmp = gfc_conv_descriptor_dtype (descriptor);
- gfc_add_modify (pblock, tmp, gfc_get_dtype (type));
-}
+gfc_conv_descriptor_dtype_set (pblock, descriptor, gfc_get_dtype (type));
or_expr = logical_false_node;
@@ -8326,7 +8322,6 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr)
the offsets because all elements are within the array data. */
/* Set the dtype. */
- tmp = gfc_conv_descriptor_dtype (parm);
if (se->unlimited_polymorphic)
dtype = gfc_get_dtype (TREE_TYPE (desc), &loop.dimen);
else if (expr->ts.type == BT_ASSUMED)
@@ -8336,11 +8331,11 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr)
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);
+ dtype = gfc_conv_descriptor_dtype_get (tmp2);
}
else
dtype = gfc_get_dtype (parmtype);
- gfc_add_modif
[gcc(refs/users/mikael/heads/refactor_descriptor_v08)] Refactoring getters & setters
https://gcc.gnu.org/g:97dc5af607e14b28980d6ea72d73ed1809ae02a6
commit 97dc5af607e14b28980d6ea72d73ed1809ae02a6
Author: Mikael Morin
Date: Tue Jul 1 22:10:35 2025 +0200
Refactoring getters & setters
Nettoyage refactoring
Correction refactoring
Diff:
---
gcc/fortran/trans-descriptor.cc | 125 ++--
1 file changed, 43 insertions(+), 82 deletions(-)
diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index 3d7cbeb7f43a..20484abd39a0 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -174,33 +174,39 @@ gfc_get_cfi_dim_sm (tree desc, tree idx)
static tree
-get_type_field (tree type, unsigned field_idx)
+get_type_field (tree type, unsigned field_idx, tree field_type = NULL_TREE)
{
tree field = gfc_advance_chain (TYPE_FIELDS (type), field_idx);
- gcc_assert (field != NULL_TREE);
+ gcc_assert (field != NULL_TREE
+ && (field_type == NULL_TREE
+ || TREE_TYPE (field) == field_type));
return field;
}
-
static tree
-gfc_get_descriptor_field (tree desc, unsigned field_idx)
+get_ref_comp (tree ref, unsigned field_idx, tree type = NULL_TREE)
{
- tree type = TREE_TYPE (desc);
- gcc_assert (GFC_DESCRIPTOR_TYPE_P (type));
-
- tree field = get_type_field (type, field_idx);
- gcc_assert (field != NULL_TREE);
+ tree field = get_type_field (TREE_TYPE (ref), field_idx, type);
return fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (field),
- desc, field, NULL_TREE);
+ ref, field, NULL_TREE);
+}
+
+
+static tree
+get_descr_comp (tree desc, unsigned field_idx, tree type = NULL_TREE)
+{
+ gcc_assert (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (desc)));
+
+ return get_ref_comp (desc, field_idx, type);
}
static tree
get_descriptor_data (tree desc)
{
- return gfc_get_descriptor_field (desc, DATA_FIELD);
+ return get_descr_comp (desc, DATA_FIELD);
}
/* This provides READ-ONLY access to the data field. The field itself
@@ -229,7 +235,7 @@ gfc_conv_descriptor_data_get (tree desc)
void
gfc_conv_descriptor_data_set (stmtblock_t *block, tree desc, tree value)
{
- tree field = gfc_get_descriptor_field (desc, DATA_FIELD);
+ tree field = get_descriptor_data (desc);
gfc_add_modify (block, field, fold_convert (TREE_TYPE (field), value));
}
@@ -237,9 +243,7 @@ gfc_conv_descriptor_data_set (stmtblock_t *block, tree
desc, tree value)
static tree
get_descriptor_offset (tree desc)
{
- tree field = gfc_get_descriptor_field (desc, OFFSET_FIELD);
- gcc_assert (TREE_TYPE (field) == gfc_array_index_type);
- return field;
+ return get_descr_comp (desc, OFFSET_FIELD, gfc_array_index_type);
}
tree
@@ -259,9 +263,7 @@ gfc_conv_descriptor_offset_set (stmtblock_t *block, tree
desc, tree value)
static tree
get_descriptor_dtype (tree desc)
{
- tree field = gfc_get_descriptor_field (desc, DTYPE_FIELD);
- gcc_assert (TREE_TYPE (field) == get_dtype_type_node ());
- return field;
+ return get_descr_comp (desc, DTYPE_FIELD, get_dtype_type_node ());
}
tree
@@ -283,9 +285,7 @@ gfc_conv_descriptor_dtype_set (stmtblock_t *block, tree
desc, tree value)
static tree
gfc_conv_descriptor_span (tree desc)
{
- tree field = gfc_get_descriptor_field (desc, SPAN_FIELD);
- gcc_assert (TREE_TYPE (field) == gfc_array_index_type);
- return field;
+ return get_descr_comp (desc, SPAN_FIELD, gfc_array_index_type);
}
tree
@@ -295,26 +295,24 @@ gfc_conv_descriptor_span_get (tree desc)
}
void
-gfc_conv_descriptor_span_set (stmtblock_t *block, tree desc,
- tree value)
+gfc_conv_descriptor_span_set (stmtblock_t *block, tree desc, tree value)
{
tree t = gfc_conv_descriptor_span (desc);
gfc_add_modify (block, t, fold_convert (TREE_TYPE (t), value));
}
+static tree
+get_dtype_comp (tree desc, unsigned field_idx, tree type = NULL_TREE)
+{
+ tree dtype_ref = get_descriptor_dtype (desc);
+ return get_ref_comp (dtype_ref, field_idx, type);
+}
+
static tree
get_descriptor_rank (tree desc)
{
- tree tmp;
- tree dtype;
-
- dtype = get_descriptor_dtype (desc);
- tmp = gfc_advance_chain (TYPE_FIELDS (TREE_TYPE (dtype)), GFC_DTYPE_RANK);
- gcc_assert (tmp != NULL_TREE
- && TREE_TYPE (tmp) == signed_char_type_node);
- return fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (tmp),
- dtype, tmp, NULL_TREE);
+ return get_dtype_comp (desc, GFC_DTYPE_RANK, signed_char_type_node);
}
tree
@@ -341,15 +339,7 @@ gfc_conv_descriptor_rank_set (stmtblock_t *block, tree
desc, int value)
static tree
get_descriptor_version (tree desc)
{
- tree tmp;
- tree dtype;
-
- dtype = get_descriptor_dtype (desc);
- tmp = gfc_advance_chain (TYPE_FIELDS (TREE_TYPE (dtype)), GFC_DTYPE_VERSION);
- gcc_assert (tmp != NULL_TREE
- && TREE_TYPE (tmp) == integer_type_node);
- return fold_build3_loc (input_location, COMPONENT_R
[gcc(refs/users/mikael/heads/refactor_descriptor_v08)] Suppression gfc_conv_descriptor_rank compil' OK
https://gcc.gnu.org/g:9ea53411d2c89b8b858d1a52c26c9d2da5906639
commit 9ea53411d2c89b8b858d1a52c26c9d2da5906639
Author: Mikael Morin
Date: Sun Jun 29 14:07:23 2025 +0200
Suppression gfc_conv_descriptor_rank compil' OK
Suppression non_lvalue rank_get
Ajout location rank_set
Diff:
---
gcc/fortran/trans-array.cc | 16 ++--
gcc/fortran/trans-decl.cc | 2 +-
gcc/fortran/trans-descriptor.cc | 24 ++--
gcc/fortran/trans-descriptor.h | 4 +++-
gcc/fortran/trans-expr.cc | 24 +++-
gcc/fortran/trans-intrinsic.cc | 10 +-
gcc/fortran/trans-openmp.cc | 2 +-
gcc/fortran/trans-stmt.cc | 2 +-
8 files changed, 46 insertions(+), 38 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index dc62f96b3782..91f19813592e 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -1186,9 +1186,7 @@ gfc_trans_create_temp_array (stmtblock_t * pre,
stmtblock_t * post, gfc_ss * ss,
/* These transformational functions change the rank. */
- tmp = gfc_conv_descriptor_rank (desc);
- gfc_add_modify (pre, tmp,
- build_int_cst (TREE_TYPE (tmp), ss->loop->dimen));
+ gfc_conv_descriptor_rank_set (pre, desc, ss->loop->dimen);
fcn_ss->info->class_container = NULL_TREE;
}
@@ -4873,7 +4871,7 @@ done:
&& (gfc_option.allow_std & GFC_STD_F202Y)))
gcc_assert (se.pre.head == NULL_TREE
&& se.post.head == NULL_TREE);
- rank = gfc_conv_descriptor_rank (se.expr);
+ rank = gfc_conv_descriptor_rank_get (se.expr);
tmp = fold_build2_loc (input_location, MINUS_EXPR,
gfc_array_index_type,
fold_convert (gfc_array_index_type,
@@ -8513,7 +8511,7 @@ gfc_tree_array_size (stmtblock_t *block, tree desc,
gfc_expr *expr, tree dim)
enum gfc_array_kind akind = GFC_TYPE_ARRAY_AKIND (TREE_TYPE (desc));
if (expr == NULL || expr->rank < 0)
rank = fold_convert (signed_char_type_node,
-gfc_conv_descriptor_rank (desc));
+gfc_conv_descriptor_rank_get (desc));
else
rank = build_int_cst (signed_char_type_node, expr->rank);
@@ -8918,8 +8916,7 @@ gfc_conv_array_parameter (gfc_se *se, gfc_expr *expr,
bool g77,
gfc_conv_descriptor_stride_get (se->expr, gfc_index_zero_node));
tree tmp2 = gfc_conv_descriptor_dtype_get (se->expr);
gfc_conv_descriptor_dtype_set (&block, arr, tmp2);
- gfc_add_modify (&block, gfc_conv_descriptor_rank (arr),
- build_int_cst (signed_char_type_node, 1));
+ gfc_conv_descriptor_rank_set (&block, arr, 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);
@@ -9203,7 +9200,7 @@ gfc_full_array_size (stmtblock_t *block, tree decl, int
rank)
tree nelems;
tree tmp;
if (rank < 0)
-idx = gfc_conv_descriptor_rank (decl);
+idx = gfc_conv_descriptor_rank_get (decl);
else
idx = gfc_rank_cst[rank - 1];
nelems = gfc_conv_descriptor_ubound_get (decl, idx);
@@ -9413,8 +9410,7 @@ duplicate_allocatable_coarray (tree dest, tree dest_tok,
tree src, tree type,
else
{
/* Set the rank or unitialized memory access may be reported. */
- tmp = gfc_conv_descriptor_rank (dest);
- gfc_add_modify (&globalblock, tmp, build_int_cst (TREE_TYPE (tmp),
rank));
+ gfc_conv_descriptor_rank_set (&globalblock, dest, rank);
if (rank)
nelems = gfc_full_array_size (&globalblock, src, rank);
diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc
index 1771be77e956..befdf2c46063 100644
--- a/gcc/fortran/trans-decl.cc
+++ b/gcc/fortran/trans-decl.cc
@@ -7375,7 +7375,7 @@ gfc_conv_cfi_to_gfc (stmtblock_t *init, stmtblock_t
*finally,
{
/* Set gfc->dtype.rank, if assumed-rank. */
rank = gfc_get_cfi_desc_rank (cfi);
- gfc_add_modify (&block, gfc_conv_descriptor_rank (gfc_desc), rank);
+ gfc_conv_descriptor_rank_set (&block, gfc_desc, rank);
}
else if (!GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (gfc_desc)))
/* In that case, the CFI rank and the declared rank can differ. */
diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index 6932becb3f0f..6b59699c652a 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -284,8 +284,8 @@ gfc_conv_descriptor_span_set (stmtblock_t *block, tree desc,
}
-tree
-gfc_conv_descriptor_rank (tree desc)
+static tree
+get_descriptor_rank (tree desc)
{
tree tmp;
tree dtype;
@@ -298,6 +298,26 @@
[gcc(refs/users/mikael/heads/refactor_descriptor_v08)] Extraction gfc_copy_sequence_descriptor
https://gcc.gnu.org/g:d13faeab8cd8bafe738485957f2ee9c591a32f30
commit d13faeab8cd8bafe738485957f2ee9c591a32f30
Author: Mikael Morin
Date: Wed Jul 23 16:34:39 2025 +0200
Extraction gfc_copy_sequence_descriptor
Diff:
---
gcc/fortran/trans-array.cc | 18 +-
gcc/fortran/trans-array.h | 1 +
gcc/fortran/trans-descriptor.cc | 22 ++
gcc/fortran/trans-descriptor.h | 2 ++
4 files changed, 26 insertions(+), 17 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index c7381f7cc261..9ca44736a1be 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -8886,23 +8886,7 @@ gfc_conv_array_parameter (gfc_se *se, gfc_expr *expr,
bool g77,
&& 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));
- tree tmp2 = gfc_conv_descriptor_dtype_get (se->expr);
- gfc_conv_descriptor_dtype_set (&block, arr, tmp2);
- gfc_conv_descriptor_rank_set (&block, arr, 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);
+ gfc_copy_sequence_descriptor (&block, arr, se->expr, expr->rank);
se->expr = arr;
}
gfc_class_array_data_assign (&block, tmp, se->expr, true);
diff --git a/gcc/fortran/trans-array.h b/gcc/fortran/trans-array.h
index 322160f47c4d..d5fa213cbf05 100644
--- a/gcc/fortran/trans-array.h
+++ b/gcc/fortran/trans-array.h
@@ -190,3 +190,4 @@ void gfc_trans_string_copy (stmtblock_t *, tree, tree, int,
tree, tree, int);
tree gfc_conv_array_extent_dim (tree, tree, tree*);
tree gfc_conv_descriptor_size (tree, int);
tree gfc_conv_descriptor_cosize (tree, int, int);
+
diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index 64fed46c7ab2..4a6cca9cc2bb 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -26,6 +26,7 @@ along with GCC; see the file COPYING3. If not see
#include "trans.h"
#include "trans-const.h"
#include "trans-types.h"
+#include "trans-array.h"
/**/
@@ -978,3 +979,24 @@ gfc_nullify_descriptor (stmtblock_t *block, tree descr)
{
gfc_conv_descriptor_data_set (block, descr, null_pointer_node);
}
+
+
+void
+gfc_copy_sequence_descriptor (stmtblock_t *block, tree dest, tree src, int
rank)
+{
+ gfc_conv_descriptor_data_set (block, dest,
+ gfc_conv_descriptor_data_get (src));
+ gfc_conv_descriptor_lbound_set (block, dest, gfc_index_zero_node,
+ gfc_index_zero_node);
+ gfc_conv_descriptor_ubound_set (block, dest, gfc_index_zero_node,
+ gfc_conv_descriptor_size (src, rank));
+ tree stride = gfc_conv_descriptor_stride_get (src, gfc_index_zero_node);
+ gfc_conv_descriptor_stride_set (block, dest, gfc_index_zero_node, stride);
+ gfc_conv_descriptor_dtype_set (block, dest,
+gfc_conv_descriptor_dtype_get (src));
+ gfc_conv_descriptor_rank_set (block, dest, 1);
+ gfc_conv_descriptor_span_set (block, dest,
+ gfc_conv_descriptor_span_get (src));
+ gfc_conv_descriptor_offset_set (block, dest, gfc_index_zero_node);
+}
+
diff --git a/gcc/fortran/trans-descriptor.h b/gcc/fortran/trans-descriptor.h
index 18b1f0109d3a..e5643b310de0 100644
--- a/gcc/fortran/trans-descriptor.h
+++ b/gcc/fortran/trans-descriptor.h
@@ -104,5 +104,7 @@ void gfc_conv_shift_descriptor (stmtblock_t *, tree, int);
void gfc_conv_shift_descriptor (stmtblock_t *, tree, const gfc_array_ref &);
/* Build a null array descriptor constructor. */
void gfc_nullify_descriptor (stmtblock_t *block, tree);
+void gfc_copy_sequence_descriptor (stmtblock_t *, tree, tree, int);
+
#endif /* GFC_TRANS_DESCRIPTOR_H */
[gcc(refs/users/mikael/heads/refactor_descriptor_v08)] Extraction gfc_conv_shift_descriptor
https://gcc.gnu.org/g:c820a4548c4b0bf7c6f9080643f2b233ad3d0e85
commit c820a4548c4b0bf7c6f9080643f2b233ad3d0e85
Author: Mikael Morin
Date: Wed Jul 16 21:39:51 2025 +0200
Extraction gfc_conv_shift_descriptor
Suppression variable inutilisée
Diff:
---
gcc/fortran/trans-descriptor.cc | 40
gcc/fortran/trans-descriptor.h | 1 +
gcc/fortran/trans-expr.cc | 36 +---
3 files changed, 42 insertions(+), 35 deletions(-)
diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index e72720967e6d..6ca84c84e9ee 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -1151,3 +1151,43 @@ gfc_conv_remap_descriptor (stmtblock_t *block, tree
dest, int dest_rank,
gfc_array_index_type, stride, tmp);
}
}
+
+
+void
+gfc_conv_shift_descriptor (stmtblock_t *block, tree dest, tree src,
+ int rank, tree zero_cond)
+{
+ 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 = gfc_conv_descriptor_lbound_get (dest, gfc_rank_cst[n]);
+ lbound = fold_build3_loc (input_location, COND_EXPR,
+ gfc_array_index_type, zero_cond,
+ gfc_index_one_node, lbound);
+ 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);
+}
+
diff --git a/gcc/fortran/trans-descriptor.h b/gcc/fortran/trans-descriptor.h
index 955778a3f412..5d4981ec29b1 100644
--- a/gcc/fortran/trans-descriptor.h
+++ b/gcc/fortran/trans-descriptor.h
@@ -109,5 +109,6 @@ void gfc_nullify_descriptor (stmtblock_t *block, tree);
void gfc_copy_sequence_descriptor (stmtblock_t *, tree, tree, int);
void gfc_conv_remap_descriptor (stmtblock_t *, tree, int, tree, int,
gfc_array_ref *);
+void gfc_conv_shift_descriptor (stmtblock_t *, tree, tree, int, tree);
#endif /* GFC_TRANS_DESCRIPTOR_H */
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 38b67b5e6a7f..3081a7fcc3a3 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -11670,7 +11670,6 @@ fcncall_realloc_result (gfc_se *se, int rank, tree
dtype)
tree desc;
tree res_desc;
tree tmp;
- tree offset;
tree zero_cond;
tree not_same_shape;
stmtblock_t shape_block;
@@ -11703,9 +11702,6 @@ fcncall_realloc_result (gfc_se *se, int rank, tree
dtype)
tmp = gfc_call_free (tmp);
gfc_add_expr_to_block (&se->post, tmp);
- tmp = gfc_conv_descriptor_data_get (res_desc);
- gfc_conv_descriptor_data_set (&se->post, desc, tmp);
-
/* Check that the shapes are the same between lhs and expression.
The evaluation of the shape is done in 'shape_block' to avoid
unitialized warnings from the lhs bounds. */
@@ -11749,37 +11745,7 @@ fcncall_realloc_result (gfc_se *se, int rank, tree
dtype)
/* Now reset the bounds returned from the function call to bounds based
on the lhs lbounds, except where the lhs is not allocated or the shapes
of 'variable and 'expr' are different. Set the offset accordingly. */
- offset = gfc_index_zero_node;
- for (n = 0 ; n < rank; n++)
-{
- tree lbound;
-
- lbound = gfc_conv_descriptor_lbound_get (desc, gfc_rank_cst[n]);
- lbound = fold_build3_loc (input_location, COND_EXPR,
- gfc_array_index_type, zero_cond,
- gfc_index_one_node, lbound);
- lbound = gfc_evaluate_now (lbound, &se->post);
-
- tmp = gfc_conv_descriptor_ubound_get (res_desc, gfc_rank_cst[n]);
- tmp = fold_build2_loc (input_location, PLUS_EXPR,
-gfc_array_index_type, tmp, lbound);
- gfc_conv_descriptor_lbound_set (&se->post, desc,
- gfc_rank_cst[n], lbound);
- gfc_c
[gcc(refs/users/mikael/heads/refactor_descriptor_v08)] Modif gfc_init_descriptor_variable
https://gcc.gnu.org/g:b2c1ff9b8b984ff851817c343b88bc9a20e48106
commit b2c1ff9b8b984ff851817c343b88bc9a20e48106
Author: Mikael Morin
Date: Sat Jul 19 15:55:19 2025 +0200
Modif gfc_init_descriptor_variable
Diff:
---
gcc/fortran/trans-descriptor.cc | 20 +---
1 file changed, 13 insertions(+), 7 deletions(-)
diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index f89ad587f62f..cc25347551a6 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -673,22 +673,28 @@ gfc_get_descriptor_offsets_for_info (const_tree
desc_type, tree *data_off,
void
gfc_init_descriptor_variable (stmtblock_t *block, gfc_symbol *sym, tree descr)
{
+ symbol_attribute attr = gfc_symbol_attr (sym);
+
/* NULLIFY the data pointer for non-saved allocatables, or for non-saved
pointers when -fcheck=pointer is specified. */
- if (sym->attr.allocatable
- || (sym->attr.pointer && (gfc_option.rtcheck & GFC_RTCHECK_POINTER)))
+ if (attr.allocatable
+ || (attr.pointer && (gfc_option.rtcheck & GFC_RTCHECK_POINTER)))
{
gfc_conv_descriptor_data_set (block, descr, null_pointer_node);
- if (flag_coarray == GFC_FCOARRAY_LIB && sym->attr.codimension)
+ if (flag_coarray == GFC_FCOARRAY_LIB && attr.codimension)
gfc_conv_descriptor_token_set (block, descr, null_pointer_node);
}
tree etype;
- gcc_assert (sym->as && sym->as->rank>=0);
+ gfc_array_spec *as;
+ if (sym->ts.type == BT_CLASS)
+as = CLASS_DATA (sym)->as;
+ else
+as = sym->as;
+
+ gcc_assert (as && as->rank >= 0);
etype = gfc_get_element_type (TREE_TYPE (descr));
gfc_conv_descriptor_dtype_set (block, descr,
-gfc_get_dtype_rank_type (sym->as->rank,
- etype));
+gfc_get_dtype_rank_type (as->rank, etype));
}
-
[gcc(refs/users/mikael/heads/refactor_descriptor_v08)] Utilisation gfc_conv_descriptor_token_set
https://gcc.gnu.org/g:79f926a636d73aa26f86e1d4999c7f41ca19df3e
commit 79f926a636d73aa26f86e1d4999c7f41ca19df3e
Author: Mikael Morin
Date: Tue Jul 15 17:17:33 2025 +0200
Utilisation gfc_conv_descriptor_token_set
Diff:
---
gcc/fortran/trans-array.cc | 12 +---
gcc/fortran/trans-descriptor.cc | 10 ++
gcc/fortran/trans-descriptor.h | 1 +
gcc/fortran/trans-expr.cc | 12 +---
gcc/fortran/trans-intrinsic.cc | 3 +--
5 files changed, 22 insertions(+), 16 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 752f17594c47..692fd0a836f9 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -8450,7 +8450,7 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr)
tmp = GFC_TYPE_ARRAY_CAF_TOKEN (TREE_TYPE (tmp));
}
- gfc_add_modify (&loop.pre, gfc_conv_descriptor_token (parm), tmp);
+ gfc_conv_descriptor_token_set (&loop.pre, parm, tmp);
}
desc = parm;
}
@@ -9059,7 +9059,7 @@ gfc_conv_array_parameter (gfc_se *se, gfc_expr *expr,
bool g77,
}
else if (!ctree)
{
- tree old_field, new_field;
+ tree old_field;
/* The original descriptor has transposed dims so we can't reuse
it directly; we have to create a new one. */
@@ -9087,8 +9087,8 @@ gfc_conv_array_parameter (gfc_se *se, gfc_expr *expr,
bool g77,
== GFC_ARRAY_ALLOCATABLE)
{
old_field = gfc_conv_descriptor_token (old_desc);
- new_field = gfc_conv_descriptor_token (new_desc);
- gfc_add_modify (&se->pre, new_field, old_field);
+ gfc_conv_descriptor_token_set (&se->pre, new_desc,
+old_field);
}
gfc_conv_descriptor_data_set (&se->pre, new_desc, ptr);
@@ -11924,9 +11924,7 @@ gfc_trans_deferred_array (gfc_symbol * sym,
gfc_wrapped_block * block)
image. This may happen, for example, with the caf_mpi
implementation. */
TREE_STATIC (descriptor) = 1;
- tmp = gfc_conv_descriptor_token (descriptor);
- gfc_add_modify (&init, tmp, fold_convert (TREE_TYPE (tmp),
- null_pointer_node));
+ gfc_conv_descriptor_token_set (&init, descriptor, null_pointer_node);
}
}
diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index 43cfce6f4411..0ac1660d21ad 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -520,6 +520,16 @@ gfc_conv_descriptor_token (tree desc)
return field;
}
+void
+gfc_conv_descriptor_token_set (stmtblock_t *block, tree desc, tree value)
+{
+ location_t loc = input_location;
+ tree t = gfc_conv_descriptor_token (desc);
+ gfc_add_modify_loc (loc, block, t,
+ fold_convert_loc (loc, TREE_TYPE (t), value));
+}
+
+
static tree
gfc_conv_descriptor_subfield (tree desc, tree dim, unsigned field_idx)
{
diff --git a/gcc/fortran/trans-descriptor.h b/gcc/fortran/trans-descriptor.h
index 0547157bf2af..3f602219c284 100644
--- a/gcc/fortran/trans-descriptor.h
+++ b/gcc/fortran/trans-descriptor.h
@@ -83,6 +83,7 @@ void gfc_conv_descriptor_dimension_set (stmtblock_t *block,
tree desc, int dim,
void gfc_conv_descriptor_stride_set (stmtblock_t *block, tree desc, tree dim,
tree value);
void gfc_conv_descriptor_lbound_set (stmtblock_t *block, tree desc, tree dim,
tree value);
void gfc_conv_descriptor_ubound_set (stmtblock_t *block, tree desc, tree dim,
tree value);
+void gfc_conv_descriptor_token_set (stmtblock_t *block, tree desc, tree value);
tree gfc_build_null_descriptor (tree type);
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index ea204fdbfcce..1f7e315e19ef 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -849,7 +849,7 @@ gfc_conv_derived_to_class (gfc_se *parmse, gfc_expr *e,
gfc_symbol *fsym,
if (POINTER_TYPE_P (TREE_TYPE (tmp)))
tmp = build_fold_indirect_ref (tmp);
gfc_get_caf_token_offset (parmse, &token, nullptr, tmp, NULL_TREE, e);
- gfc_add_modify (&parmse->pre, gfc_conv_descriptor_token (ctree), token);
+ gfc_conv_descriptor_token_set (&parmse->pre, ctree, token);
}
if (optional)
@@ -9840,8 +9840,7 @@ gfc_trans_subcomponent_assign (tree dest, gfc_component *
cm,
{
gfc_conv_descriptor_data_set (&block, dest, null_pointer_node);
if (cm->attr.codimension && flag_coarray == GFC_FCOARRAY_LIB)
- gfc_add_modify (&block, gfc_conv_descriptor_token (dest),
- null_pointer_node);
+ gfc_conv_descriptor_token_set (&block, dest, null_pointer_node);
}
else if (cm->attr.allocatable || cm->attr.pdt_array)
{
@@ -11599,10 +11598,9 @@ gfc_trans_scalar
[gcc(refs/users/mikael/heads/refactor_descriptor_v08)] Extraction fonction gfc_nullify_descriptor
https://gcc.gnu.org/g:65956591d49e9780bd989fec3b42fd80694a7df0
commit 65956591d49e9780bd989fec3b42fd80694a7df0
Author: Mikael Morin
Date: Wed Jul 16 16:49:28 2025 +0200
Extraction fonction gfc_nullify_descriptor
Diff:
---
gcc/fortran/trans-descriptor.cc | 6 ++
gcc/fortran/trans-descriptor.h | 5 -
gcc/fortran/trans-expr.cc | 2 +-
3 files changed, 11 insertions(+), 2 deletions(-)
diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index aad233cc7f1a..64fed46c7ab2 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -972,3 +972,9 @@ gfc_conv_shift_descriptor (stmtblock_t *block, tree desc,
conv_shift_descriptor (block, desc, as);
}
+
+void
+gfc_nullify_descriptor (stmtblock_t *block, tree descr)
+{
+ gfc_conv_descriptor_data_set (block, descr, null_pointer_node);
+}
diff --git a/gcc/fortran/trans-descriptor.h b/gcc/fortran/trans-descriptor.h
index f8492c23d793..18b1f0109d3a 100644
--- a/gcc/fortran/trans-descriptor.h
+++ b/gcc/fortran/trans-descriptor.h
@@ -19,7 +19,6 @@ along with GCC; see the file COPYING3. If not see
#ifndef GFC_TRANS_DESCRIPTOR_H
#define GFC_TRANS_DESCRIPTOR_H
-tree gfc_build_default_class_descriptor (const gfc_typespec &, tree);
void gfc_set_scalar_null_descriptor (stmtblock_t *block, tree, gfc_symbol *,
gfc_expr *, tree);
void gfc_set_descriptor_with_shape (stmtblock_t *, tree, tree,
gfc_expr *, locus *);
@@ -93,7 +92,9 @@ gfc_get_descriptor_offsets_for_info (const_tree desc_type,
tree *data_off,
void gfc_init_descriptor_variable (stmtblock_t *block, gfc_symbol *sym, tree
descr);
void gfc_init_descriptor_result (stmtblock_t *block, tree descr);
+tree gfc_build_default_class_descriptor (const gfc_typespec &, tree);
void gfc_nullify_descriptor (stmtblock_t *block, gfc_symbol *, gfc_expr *,
tree, tree);
+void gfc_nullify_descriptor (stmtblock_t *block, gfc_expr *, tree);
void gfc_init_static_descriptor (tree descr);
void gfc_init_absent_descriptor (stmtblock_t *block, tree descr);
void gfc_set_scalar_descriptor (stmtblock_t *, tree, tree);
@@ -101,5 +102,7 @@ void gfc_nullify_descriptor (stmtblock_t *, gfc_expr *,
tree, tree);
void gfc_conv_shift_descriptor_lbound (stmtblock_t *, tree, int, tree);
void gfc_conv_shift_descriptor (stmtblock_t *, tree, int);
void gfc_conv_shift_descriptor (stmtblock_t *, tree, const gfc_array_ref &);
+/* Build a null array descriptor constructor. */
+void gfc_nullify_descriptor (stmtblock_t *block, tree);
#endif /* GFC_TRANS_DESCRIPTOR_H */
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index b39186d1ab57..26a1ded0d268 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -11053,7 +11053,7 @@ gfc_trans_pointer_assignment (gfc_expr * expr1,
gfc_expr * expr2)
if (expr2->expr_type == EXPR_NULL)
{
/* Just set the data pointer to null. */
- gfc_conv_descriptor_data_set (&lse.pre, lse.expr, null_pointer_node);
+ gfc_nullify_descriptor (&lse.pre, lse.expr);
}
else if (rank_remap)
{
[gcc(refs/users/mikael/heads/refactor_descriptor_v08)] Extraction gfc_copy_descriptor
https://gcc.gnu.org/g:5c8e7f7ef823fcd1f4c6b8e76cb137520623b6f2
commit 5c8e7f7ef823fcd1f4c6b8e76cb137520623b6f2
Author: Mikael Morin
Date: Wed Jul 16 22:09:17 2025 +0200
Extraction gfc_copy_descriptor
Diff:
---
gcc/fortran/trans-array.cc | 25 ++---
gcc/fortran/trans-descriptor.cc | 33 +
gcc/fortran/trans-descriptor.h | 1 +
3 files changed, 36 insertions(+), 23 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 980f4069fdcd..5af9917124aa 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -7869,29 +7869,8 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr)
if (full && !transposed_dims (ss))
{
if (se->direct_byref && !se->byref_noassign)
- {
- struct lang_type *lhs_ls
- = TYPE_LANG_SPECIFIC (TREE_TYPE (se->expr)),
- *rhs_ls = TYPE_LANG_SPECIFIC (TREE_TYPE (desc));
- /* When only the array_kind differs, do a view_convert. */
- tmp = lhs_ls && rhs_ls && lhs_ls->rank == rhs_ls->rank
- && lhs_ls->akind != rhs_ls->akind
- ? build1 (VIEW_CONVERT_EXPR, TREE_TYPE (se->expr), desc)
- : desc;
- /* Copy the descriptor for pointer assignments. */
- gfc_add_modify (&se->pre, se->expr, tmp);
-
- /* 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);
- }
+ gfc_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
diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index 6ca84c84e9ee..50404826d616 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -1191,3 +1191,36 @@ gfc_conv_shift_descriptor (stmtblock_t *block, tree
dest, tree src,
gfc_conv_descriptor_offset_set (block, dest, offset);
}
+
+void
+gfc_copy_descriptor (stmtblock_t *block, tree dest, tree src,
+gfc_expr *src_expr, bool subref)
+{
+ struct lang_type *dest_ls = TYPE_LANG_SPECIFIC (TREE_TYPE (dest));
+ struct lang_type *src_ls = TYPE_LANG_SPECIFIC (TREE_TYPE (src));
+
+ /* When only the array_kind differs, do a view_convert. */
+ tree tmp1;
+ if (dest_ls
+ && src_ls
+ && dest_ls->rank == src_ls->rank
+ && dest_ls->akind != src_ls->akind)
+tmp1 = build1 (VIEW_CONVERT_EXPR, TREE_TYPE (dest), src);
+ else
+tmp1 = src;
+
+ /* Copy the descriptor for pointer assignments. */
+ gfc_add_modify (block, dest, tmp1);
+
+ /* Add any offsets from subreferences. */
+ gfc_get_dataptr_offset (block, dest, src, NULL_TREE, subref, src_expr);
+
+ /* and set the span field. */
+ tree tmp2;
+ if (src_expr->ts.type == BT_CHARACTER)
+tmp2 = gfc_conv_descriptor_span_get (src);
+ else
+tmp2 = gfc_get_array_span (src, src_expr);
+ gfc_conv_descriptor_span_set (block, dest, tmp2);
+}
+
diff --git a/gcc/fortran/trans-descriptor.h b/gcc/fortran/trans-descriptor.h
index 5d4981ec29b1..5ae3f88cad54 100644
--- a/gcc/fortran/trans-descriptor.h
+++ b/gcc/fortran/trans-descriptor.h
@@ -110,5 +110,6 @@ void gfc_copy_sequence_descriptor (stmtblock_t *, tree,
tree, int);
void gfc_conv_remap_descriptor (stmtblock_t *, tree, int, tree, int,
gfc_array_ref *);
void gfc_conv_shift_descriptor (stmtblock_t *, tree, tree, int, tree);
+void gfc_copy_descriptor (stmtblock_t *, tree, tree, gfc_expr *, bool);
#endif /* GFC_TRANS_DESCRIPTOR_H */
[gcc(refs/users/mikael/heads/refactor_descriptor_v08)] Déplacement gfc_descriptor_size
https://gcc.gnu.org/g:75c19aaab11ae3d86586e961a20e2886e80d5c83
commit 75c19aaab11ae3d86586e961a20e2886e80d5c83
Author: Mikael Morin
Date: Wed Jul 23 16:36:42 2025 +0200
Déplacement gfc_descriptor_size
Diff:
---
gcc/fortran/trans-array.cc | 47 -
gcc/fortran/trans-array.h | 2 --
gcc/fortran/trans-descriptor.cc | 47 +
gcc/fortran/trans-descriptor.h | 2 ++
4 files changed, 49 insertions(+), 49 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 9ca44736a1be..980f4069fdcd 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -5765,53 +5765,6 @@ gfc_conv_array_extent_dim (tree lbound, tree ubound,
tree* 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. */
-
-static tree
-gfc_conv_descriptor_size_1 (tree desc, int from_dim, int to_dim)
-{
- tree res;
- int dim;
-
- res = gfc_index_one_node;
-
- 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);
- res = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
-res, extent);
-}
-
- return res;
-}
-
-
-/* Full size of an array. */
-
-tree
-gfc_conv_descriptor_size (tree desc, int rank)
-{
- return gfc_conv_descriptor_size_1 (desc, 0, rank);
-}
-
-
-/* Size of a coarray for all dimensions but the last. */
-
-tree
-gfc_conv_descriptor_cosize (tree desc, int rank, int corank)
-{
- return gfc_conv_descriptor_size_1 (desc, rank, rank + corank - 1);
-}
-
-
/* 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,
diff --git a/gcc/fortran/trans-array.h b/gcc/fortran/trans-array.h
index d5fa213cbf05..1d737fc2efa9 100644
--- a/gcc/fortran/trans-array.h
+++ b/gcc/fortran/trans-array.h
@@ -188,6 +188,4 @@ void gfc_trans_string_copy (stmtblock_t *, tree, tree, int,
tree, tree, int);
/* Calculate extent / size of an array. */
tree gfc_conv_array_extent_dim (tree, tree, tree*);
-tree gfc_conv_descriptor_size (tree, int);
-tree gfc_conv_descriptor_cosize (tree, int, int);
diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index 4a6cca9cc2bb..61752f087b59 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -732,6 +732,53 @@ gfc_nullify_descriptor (stmtblock_t *block, gfc_symbol
*sym, gfc_expr *expr,
gfc_conv_descriptor_dtype_set (block, descr, dtype);
}
+
+/* For an array descriptor, get the total number of elements. This is just
+ the product of the extents along from_dim to to_dim. */
+
+static tree
+gfc_conv_descriptor_size_1 (tree desc, int from_dim, int to_dim)
+{
+ tree res;
+ int dim;
+
+ res = gfc_index_one_node;
+
+ 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);
+ res = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
+res, extent);
+}
+
+ return res;
+}
+
+
+/* Full size of an array. */
+
+tree
+gfc_conv_descriptor_size (tree desc, int rank)
+{
+ return gfc_conv_descriptor_size_1 (desc, 0, rank);
+}
+
+
+/* Size of a coarray for all dimensions but the last. */
+
+tree
+gfc_conv_descriptor_cosize (tree desc, int rank, int corank)
+{
+ return gfc_conv_descriptor_size_1 (desc, rank, rank + corank - 1);
+}
+
void
gfc_init_descriptor_variable (stmtblock_t *block, gfc_symbol *sym,
gfc_expr *expr, tree descr)
diff --git a/gcc/fortran/trans-descriptor.h b/gcc/fortran/trans-descriptor.h
index e5643b310de0..ac7960589abb 100644
--- a/gcc/fortran/trans-descriptor.h
+++ b/gcc/fortran/trans-descriptor.h
@@ -82,6 +82,8 @@ void gfc_conv_descriptor_ubound_set (stmtblock_t *block, tree
desc, tree dim, tr
void gfc_conv_descriptor_token_set (stmtblock_t *block, tree desc, tree value);
tree gfc_build_null_descriptor (tree type);
+tree gfc_conv_descriptor_size (tree, int);
+tree gfc_conv_descriptor_cosize (tree, int, int);
void
gfc_get_descriptor_offsets_for_info (const_tree desc_type, tree *data_off,
[gcc(refs/users/mikael/heads/refactor_descriptor_v08)] Factorisation gfc_set_contiguous_descriptor
https://gcc.gnu.org/g:49b29209112310107684b8f6d1638aa9f2aeff1f
commit 49b29209112310107684b8f6d1638aa9f2aeff1f
Author: Mikael Morin
Date: Fri Jan 17 17:25:59 2025 +0100
Factorisation gfc_set_contiguous_descriptor
Factorisation set_contiguous_array
Diff:
---
gcc/fortran/trans-array.cc | 54 +++--
gcc/fortran/trans-descriptor.cc | 18 ++
gcc/fortran/trans-descriptor.h | 1 +
3 files changed, 33 insertions(+), 40 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 72df5eb1062f..28dee67e8154 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -9497,32 +9497,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_conv_descriptor_dtype_set (&tmpblock, 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)))
@@ -9545,13 +9519,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;
+
+ gfc_set_contiguous_descriptor (&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),
@@ -9699,21 +9683,11 @@ structure_alloc_comps (gfc_symbol * der_type, tree
decl, tree dest,
cdesc = gfc_create_var (cdesc, "cdesc");
DECL_ARTIFICIAL (cdesc) = 1;
- gfc_conv_descriptor_dtype_set (&dealloc_block, 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);
+ gfc_set_contiguous_descriptor (&dealloc_block, cdesc, ubound,
+comp);
/* Now call the deallocator. */
vtab = gfc_find_vtab (&c->ts);
diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index 240f0c46fd27..e8cb4831f559 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -1393,3 +1393,21 @@ gfc_set_descriptor (stmtblock_t *block, tree dest, tree
src,
[gcc(refs/users/mikael/heads/refactor_descriptor_v08)] Extraction gfc_build_default_class_descriptor
https://gcc.gnu.org/g:e4bb3f674c726c4f7316db0057372ef504979ca6
commit e4bb3f674c726c4f7316db0057372ef504979ca6
Author: Mikael Morin
Date: Tue Jul 15 20:30:45 2025 +0200
Extraction gfc_build_default_class_descriptor
Correction régression class_allocate_14
Diff:
---
gcc/fortran/trans-decl.cc | 24 ++
gcc/fortran/trans-descriptor.cc | 44 -
gcc/fortran/trans-descriptor.h | 4 +++-
gcc/fortran/trans-expr.cc | 14 ++---
gcc/fortran/trans.h | 1 +
5 files changed, 56 insertions(+), 31 deletions(-)
diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc
index e5e813e551ca..f33bff9fe0b2 100644
--- a/gcc/fortran/trans-decl.cc
+++ b/gcc/fortran/trans-decl.cc
@@ -4940,30 +4940,10 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym,
gfc_wrapped_block * block)
&& (sym->attr.save || flag_max_stack_var_size == 0)
&& CLASS_DATA (sym)->attr.allocatable)
{
- tree vptr;
-
- if (UNLIMITED_POLY (sym))
- vptr = null_pointer_node;
- else
- {
- gfc_symbol *vsym;
- vsym = gfc_find_derived_vtab (sym->ts.u.derived);
- vptr = gfc_get_symbol_decl (vsym);
- vptr = gfc_build_addr_expr (NULL, vptr);
- }
-
- if (CLASS_DATA (sym)->attr.dimension
- || (CLASS_DATA (sym)->attr.codimension
- && flag_coarray != GFC_FCOARRAY_LIB))
- {
- tmp = gfc_class_data_get (sym->backend_decl);
- tmp = gfc_build_null_descriptor (TREE_TYPE (tmp));
- }
- else
- tmp = null_pointer_node;
+ tree class_type = TREE_TYPE (sym->backend_decl);
DECL_INITIAL (sym->backend_decl)
- = gfc_class_set_static_fields (sym->backend_decl, vptr, tmp);
+ = gfc_build_default_class_descriptor (sym->ts, class_type);
TREE_CONSTANT (DECL_INITIAL (sym->backend_decl)) = 1;
}
else if ((sym->attr.dimension || sym->attr.codimension
diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index 27c85d4e73c1..57570145118d 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -173,8 +173,8 @@ gfc_get_cfi_dim_sm (tree desc, tree idx)
#define UBOUND_SUBFIELD 2
-static tree
-get_type_field (tree type, unsigned field_idx, tree field_type = NULL_TREE)
+tree
+gfc_get_type_field (tree type, unsigned field_idx, tree field_type = NULL_TREE)
{
tree field = gfc_advance_chain (TYPE_FIELDS (type), field_idx);
gcc_assert (field != NULL_TREE
@@ -187,7 +187,7 @@ get_type_field (tree type, unsigned field_idx, tree
field_type = NULL_TREE)
static tree
get_ref_comp (tree ref, unsigned field_idx, tree type = NULL_TREE)
{
- tree field = get_type_field (TREE_TYPE (ref), field_idx, type);
+ tree field = gfc_get_type_field (TREE_TYPE (ref), field_idx, type);
return fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (field),
ref, field, NULL_TREE);
@@ -415,8 +415,9 @@ gfc_conv_descriptor_type_set (stmtblock_t *block, tree
desc, int value)
tree type = TREE_TYPE (desc);
gcc_assert (GFC_DESCRIPTOR_TYPE_P (type));
- tree dtype_field = get_type_field (type, DTYPE_FIELD, get_dtype_type_node
());
- tree field = get_type_field (TREE_TYPE (dtype_field), GFC_DTYPE_TYPE);
+ tree dtype_field = gfc_get_type_field (type, DTYPE_FIELD,
+get_dtype_type_node ());
+ tree field = gfc_get_type_field (TREE_TYPE (dtype_field), GFC_DTYPE_TYPE);
tree type_value = build_int_cst (TREE_TYPE (field), value);
gfc_conv_descriptor_type_set (block, desc, type_value);
@@ -706,3 +707,36 @@ gfc_init_descriptor_result (stmtblock_t *block, tree descr)
gfc_conv_descriptor_data_set (block, descr, null_pointer_node);
}
+
+tree
+gfc_build_default_class_descriptor (const gfc_typespec &ts, tree class_type)
+{
+ gcc_assert (ts.type == BT_CLASS);
+
+ gfc_symbol *derived = ts.u.derived;
+
+ tree vptr;
+ if (derived->attr.unlimited_polymorphic)
+vptr = null_pointer_node;
+ else
+{
+ gfc_symbol *vsym;
+ vsym = gfc_find_derived_vtab (derived);
+ vptr = gfc_get_symbol_decl (vsym);
+ vptr = gfc_build_addr_expr (NULL, vptr);
+}
+
+ tree tmp;
+ if (derived->components->attr.dimension
+ || (derived->components->attr.codimension
+ && flag_coarray != GFC_FCOARRAY_LIB))
+{
+ tmp = gfc_class_type_data_field_get (class_type);
+ tmp = gfc_build_null_descriptor (TREE_TYPE (tmp));
+}
+ else
+tmp = null_pointer_node;
+
+ return gfc_class_set_static_fields (class_type, vptr, tmp);
+}
+
diff --git a/gcc/fortran/trans-descriptor.h b/gcc/fortran/trans-descriptor.h
index 0b6540116452..f5b5e59f1cfe 100644
--- a/gcc/fortran/trans-descriptor.h
+++ b/gcc/fortran/trans-descriptor.h
@@ -21,7 +21,7 @@ along with GCC; see the
[gcc(refs/users/mikael/heads/refactor_descriptor_v08)] Extraction gfc_conv_shift_subarray_descriptor
https://gcc.gnu.org/g:c934351af60554a17c6e930c53ef1649e03c9455
commit c934351af60554a17c6e930c53ef1649e03c9455
Author: Mikael Morin
Date: Tue Jul 22 11:16:59 2025 +0200
Extraction gfc_conv_shift_subarray_descriptor
Correction alloc_comp_constructor_5
Diff:
---
gcc/fortran/trans-descriptor.cc | 73 +++
gcc/fortran/trans-descriptor.h | 1 +
gcc/fortran/trans-expr.cc | 84 +++--
3 files changed, 80 insertions(+), 78 deletions(-)
diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index aeb93eda7fc7..c9ecfea0dd79 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -1489,3 +1489,76 @@ gfc_set_descriptor_with_shape (stmtblock_t *block, tree
desc,
gfc_conv_descriptor_offset_set (block, desc, offset);
}
+
+void
+gfc_set_subarray_descriptor (stmtblock_t *block, tree descr, 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. */
+ gfc_conv_descriptor_offset_set (block, descr, gfc_index_zero_node);
+ tree offset = gfc_conv_descriptor_offset_get (descr);
+ 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 (descr, 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 (descr, gfc_rank_cst[n]);
+ span = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
+ tmp, gfc_conv_descriptor_lbound_get (descr, gfc_rank_cst[n]));
+ tmp = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
+span, lbound);
+ gfc_conv_descriptor_ubound_set (block, descr, gfc_rank_cst[n], tmp);
+ gfc_conv_descriptor_lbound_set (block, descr, gfc_rank_cst[n], lbound);
+
+ tmp = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
+gfc_conv_descriptor_lbound_get (descr,
+gfc_rank_cst[n]),
+gfc_conv_descriptor_stride_get (descr,
+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, descr, tmp);
+}
+}
+
diff --git a/gcc/fortran/trans-descriptor.h b/gcc/fortran/trans-descriptor.h
index b17b71b09809..c9ad4541d970 100644
--- a/gcc/fortran/trans-descriptor.h
+++ b/gcc/fortran/trans-descriptor.h
@@ -121,5 +121,6 @@ gfc_set_descriptor (stmtblock_t *block, tree dest, tree
src, gfc_expr *src_expr,
void gfc_set_contiguous_descriptor (stmtblock_t *, tree, tree, tree);
void gfc_set_descriptor_with_shape (stmtblock_t *, tree, tree, gfc_expr *,
locus *);
+void gfc_set_subarray_descriptor (stmtblock_t *, tree, tree, gfc_expr *,
gfc_expr *);
#endif /* GFC_TRANS_DESCRIPTOR_H */
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index fe2e9f6475fc..54e7f587420e 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -9479,12 +9479,7 @@ gfc_trans_alloc_subarray_assign (tree dest,
gfc_component * cm,
{
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)
[gcc(refs/users/mikael/heads/refactor_descriptor_v08)] Extraction gfc_set_descriptor
https://gcc.gnu.org/g:f6e4787f0d1791cce81e1abfc98b57974720808c
commit f6e4787f0d1791cce81e1abfc98b57974720808c
Author: Mikael Morin
Date: Sun Jul 20 17:25:26 2025 +0200
Extraction gfc_set_descriptor
Correction bootstsrap
Diff:
---
gcc/fortran/trans-array.cc | 163 +-
gcc/fortran/trans-descriptor.cc | 169
gcc/fortran/trans-descriptor.h | 7 ++
3 files changed, 179 insertions(+), 160 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 5af9917124aa..72df5eb1062f 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -,7 +,6 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr)
tree tmp;
tree desc;
stmtblock_t block;
- tree start;
int full;
bool subref_array_target = false;
bool deferred_array_component = false;
@@ -8091,12 +8090,6 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr)
int dim, ndim, codim;
tree parm;
tree parmtype;
- tree dtype;
- tree stride;
- tree from;
- tree to;
- tree base;
- tree offset;
ndim = info->ref ? info->ref->u.ar.dimen : ss->dimen;
@@ -8217,160 +8210,10 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr)
gfc_get_array_span (desc, expr)));
}
- /* Set the span field. */
- tmp = NULL_TREE;
- if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (desc)))
- tmp = gfc_conv_descriptor_span_get (desc);
- else
- tmp = gfc_get_array_span (desc, expr);
- if (tmp)
- gfc_conv_descriptor_span_set (&loop.pre, parm, tmp);
-
- /* The following can be somewhat confusing. We have two
- descriptors, a new one and the original array.
- {parm, parmtype, dim} refer to the new one.
- {desc, 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. */
- if (se->unlimited_polymorphic)
- dtype = gfc_get_dtype (TREE_TYPE (desc), &loop.dimen);
- else if (expr->ts.type == BT_ASSUMED)
- {
- tree tmp2 = desc;
- 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_get (tmp2);
- }
- else
- dtype = gfc_get_dtype (parmtype);
- gfc_conv_descriptor_dtype_set (&loop.pre, parm, dtype);
-
- /* The 1st element in the section. */
- base = gfc_index_zero_node;
- if (expr->ts.type == BT_CHARACTER && expr->rank == 0 && codim)
- base = gfc_index_one_node;
-
- /* The offset from the 1st element in the section. */
- offset = gfc_index_zero_node;
-
- for (n = 0; n < ndim; n++)
- {
- stride = gfc_conv_array_stride (desc, n);
-
- /* Work out the 1st element in the section. */
- 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, &loop.pre);
- }
-
- tmp = gfc_conv_array_lbound (desc, 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)
- {
- /* For elemental dimensions, we only need the 1st
-element in the section. */
- continue;
- }
-
- /* Vector subscripts need copying and are handled elsewhere. */
- if (info->ref)
- gcc_assert (info->ref->u.ar.dimen_type[n] == DIMEN_RANGE);
-
- /* look for the corresponding scalarizer dimension: dim. */
- for (dim = 0; dim < ndim; dim++)
- if (ss->dim[dim] == n)
- break;
-
- /* loop exited early: the DIM being looked for has been found. */
- gcc_assert (dim < ndim);
+ gfc_set_descriptor (&loop.pre, parm, desc, expr, loop.dimen
[gcc(refs/users/mikael/heads/refactor_descriptor_v08)] Creation gfc_conv_null_array_descriptor, gfc_conv_scalar_null_to_descriptor
https://gcc.gnu.org/g:e435054aec40ff635ed04241685f67b44baf076e
commit e435054aec40ff635ed04241685f67b44baf076e
Author: Mikael Morin
Date: Sat Jul 19 13:55:28 2025 +0200
Creation gfc_conv_null_array_descriptor, gfc_conv_scalar_null_to_descriptor
Revert "Renommage gfc_clear_descriptor -> gfc_init_descriptor_variable"
This reverts commit 6a87820bffc834c09c5dcf8edb61f55cf6eec34c.
Revert "Correction compilation"
This reverts commit 5131afedc5568d33c68046a098a0143f9ae03eb9.
Revert partiel
Renseignement expression
Renommage
Correction régression null_actual_6
Diff:
---
gcc/fortran/trans-descriptor.cc | 47 +++--
gcc/fortran/trans-descriptor.h | 5 ++-
gcc/fortran/trans-expr.cc | 93 +
gcc/fortran/trans-types.cc | 9 +++-
gcc/fortran/trans-types.h | 1 +
gcc/fortran/trans.h | 1 +
6 files changed, 132 insertions(+), 24 deletions(-)
diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index e3762d70bb36..2d48a1834ba1 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -671,7 +671,8 @@ gfc_get_descriptor_offsets_for_info (const_tree desc_type,
tree *data_off,
#undef UBOUND_SUBFIELD
void
-gfc_init_descriptor_variable (stmtblock_t *block, gfc_symbol *sym, gfc_expr
*expr, tree descr)
+gfc_nullify_descriptor (stmtblock_t *block, gfc_symbol *sym, gfc_expr *expr,
+ tree descr, tree string_length)
{
symbol_attribute attr = gfc_symbol_attr (sym);
@@ -705,8 +706,15 @@ gfc_init_descriptor_variable (stmtblock_t *block,
gfc_symbol *sym, gfc_expr *exp
rank = -1;
etype = gfc_get_element_type (TREE_TYPE (descr));
- gfc_conv_descriptor_dtype_set (block, descr,
-gfc_get_dtype_rank_type (rank, etype));
+ tree dtype = gfc_get_dtype_rank_type_slen (rank, etype, string_length);
+ gfc_conv_descriptor_dtype_set (block, descr, dtype);
+}
+
+void
+gfc_init_descriptor_variable (stmtblock_t *block, gfc_symbol *sym,
+ gfc_expr *expr, tree descr)
+{
+ return gfc_nullify_descriptor (block, sym, expr, descr, NULL_TREE);
}
@@ -771,3 +779,36 @@ gfc_init_absent_descriptor (stmtblock_t *block, tree descr)
gfc_conv_descriptor_data_set (block, descr, null_pointer_node);
}
+
+void
+gfc_set_scalar_descriptor (stmtblock_t *block, tree descr, tree value)
+{
+ tree etype = TREE_TYPE (value);
+
+ if (POINTER_TYPE_P (etype)
+ && TREE_TYPE (etype)
+ && TREE_CODE (TREE_TYPE (etype)) == ARRAY_TYPE)
+etype = TREE_TYPE (etype);
+ gfc_conv_descriptor_dtype_set (block, descr,
+gfc_get_dtype_rank_type (0, etype));
+ gfc_conv_descriptor_data_set (block, descr, value);
+ gfc_conv_descriptor_span_set (block, descr,
+ gfc_conv_descriptor_elem_len_get (descr));
+}
+
+
+void
+gfc_nullify_descriptor (stmtblock_t *block, gfc_expr *expr, tree descr,
+ tree string_length)
+{
+ tree etype = gfc_get_element_type (TREE_TYPE (descr));
+ if (TREE_TYPE (etype) && TREE_CODE (TREE_TYPE (etype)) == ARRAY_TYPE)
+etype = TREE_TYPE (etype);
+ gfc_conv_descriptor_dtype_set (block, descr,
+gfc_get_dtype_rank_type_slen (expr->rank,
etype,
+ string_length));
+ gfc_conv_descriptor_data_set (block, descr, null_pointer_node);
+ gfc_conv_descriptor_span_set (block, descr,
+ gfc_conv_descriptor_elem_len_get (descr));
+}
+
diff --git a/gcc/fortran/trans-descriptor.h b/gcc/fortran/trans-descriptor.h
index de57a8e606e8..92603cde494a 100644
--- a/gcc/fortran/trans-descriptor.h
+++ b/gcc/fortran/trans-descriptor.h
@@ -19,9 +19,7 @@ along with GCC; see the file COPYING3. If not see
#ifndef GFC_TRANS_DESCRIPTOR_H
#define GFC_TRANS_DESCRIPTOR_H
-/* Build a null array descriptor constructor. */
tree gfc_build_default_class_descriptor (const gfc_typespec &, tree);
-void gfc_nullify_descriptor (stmtblock_t *block, gfc_expr *, tree);
void gfc_set_scalar_null_descriptor (stmtblock_t *block, tree, gfc_symbol *,
gfc_expr *, tree);
void gfc_set_descriptor_with_shape (stmtblock_t *, tree, tree,
gfc_expr *, locus *);
@@ -95,7 +93,10 @@ gfc_get_descriptor_offsets_for_info (const_tree desc_type,
tree *data_off,
void gfc_init_descriptor_variable (stmtblock_t *block, gfc_symbol *sym, tree
descr);
void gfc_init_descriptor_result (stmtblock_t *block, tree descr);
+void gfc_nullify_descriptor (stmtblock_t *block, gfc_symbol *, gfc_expr *,
tree, tree);
void gfc_init_static_descriptor (tree descr);
void gfc_init_absent_descriptor (stmtblock_t *block, tree descr);
+void gfc_set_scalar_descriptor (stmtblock_t *, tree, tree);
+void gfc_nullify_descriptor (stmtblock_t *, gfc_expr *, tree, tree);
[gcc(refs/users/mikael/heads/refactor_descriptor_v08)] Extraction gfc_conv_remap_descriptor
https://gcc.gnu.org/g:b8fb22c3271fc672935476a3885b9a0a613b2ddb
commit b8fb22c3271fc672935476a3885b9a0a613b2ddb
Author: Mikael Morin
Date: Wed Jul 23 17:07:24 2025 +0200
Extraction gfc_conv_remap_descriptor
Diff:
---
gcc/fortran/trans-descriptor.cc | 104 +
gcc/fortran/trans-descriptor.h | 3 +-
gcc/fortran/trans-expr.cc | 111 +---
3 files changed, 108 insertions(+), 110 deletions(-)
diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index 61752f087b59..e72720967e6d 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -1047,3 +1047,107 @@ gfc_copy_sequence_descriptor (stmtblock_t *block, tree
dest, tree src, int rank)
gfc_conv_descriptor_offset_set (block, dest, gfc_index_zero_node);
}
+
+void
+gfc_conv_remap_descriptor (stmtblock_t *block, tree dest, int dest_rank,
+ tree src, int src_rank, gfc_array_ref *ar)
+{
+ /* Set dtype. */
+ gfc_conv_descriptor_dtype_set (block, dest,
+gfc_get_dtype (TREE_TYPE (dest)));
+
+ /* Copy data pointer. */
+ gfc_conv_descriptor_data_set (block, dest,
+ gfc_conv_descriptor_data_get (src));
+
+ /* Copy the span. */
+ tree span;
+ if (VAR_P (src)
+ && GFC_DECL_PTR_ARRAY_P (src))
+span = gfc_conv_descriptor_span_get (src);
+ else
+{
+ tree 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]);
+ tree 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 (ar->start[dim] && ar->end[dim]);
+
+ if (ar->start[dim]->expr_type != EXPR_CONSTANT
+ || ar->start[dim]->expr_type != EXPR_VARIABLE)
+ gfc_resolve_expr (ar->start[dim]);
+ if (ar->end[dim]->expr_type != EXPR_CONSTANT
+ || ar->end[dim]->expr_type != EXPR_VARIABLE)
+ gfc_resolve_expr (ar->end[dim]);
+
+ /* Convert declared bounds. */
+ gfc_init_se (&lower_se, NULL);
+ gfc_init_se (&upper_se, NULL);
+ gfc_conv_expr (&lower_se, ar->start[dim]);
+ gfc_conv_expr (&upper_se, ar->end[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);
+ tree 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);
+}
+}
diff --git a/gcc/fortran/trans-descriptor.h b/gcc/fortran/trans-descriptor.h
index ac
[gcc(refs/users/mikael/heads/refactor_descriptor_v08)] Extraction gfc_init_absent_descriptor
https://gcc.gnu.org/g:a1229258129202a7ad11928788805b256c7c03e7
commit a1229258129202a7ad11928788805b256c7c03e7
Author: Mikael Morin
Date: Tue Jul 15 21:49:27 2025 +0200
Extraction gfc_init_absent_descriptor
Correction gfc_clear_descriptor assumed rank
Correction partielle class_optional_2
Correction class_optional_2
Diff:
---
gcc/fortran/trans-descriptor.cc | 31 +++
gcc/fortran/trans-descriptor.h | 2 +-
gcc/fortran/trans-expr.cc | 5 ++---
3 files changed, 30 insertions(+), 8 deletions(-)
diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index 26fd6ba4fcf8..e3762d70bb36 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -670,15 +670,15 @@ gfc_get_descriptor_offsets_for_info (const_tree
desc_type, tree *data_off,
#undef LBOUND_SUBFIELD
#undef UBOUND_SUBFIELD
-
void
-gfc_init_descriptor_variable (stmtblock_t *block, gfc_symbol *sym, tree descr)
+gfc_init_descriptor_variable (stmtblock_t *block, gfc_symbol *sym, gfc_expr
*expr, tree descr)
{
symbol_attribute attr = gfc_symbol_attr (sym);
/* NULLIFY the data pointer for non-saved allocatables, or for non-saved
pointers when -fcheck=pointer is specified. */
if (attr.allocatable
+ || attr.optional
|| (attr.pointer && (gfc_option.rtcheck & GFC_RTCHECK_POINTER)))
{
gfc_conv_descriptor_data_set (block, descr, null_pointer_node);
@@ -694,10 +694,26 @@ gfc_init_descriptor_variable (stmtblock_t *block,
gfc_symbol *sym, tree descr)
else
as = sym->as;
- gcc_assert (as && as->rank >= 0);
+ int rank;
+ if (as == nullptr)
+rank = 0;
+ else if (as->type != AS_ASSUMED_RANK)
+rank = as->rank;
+ else if (expr)
+rank = expr->rank;
+ else
+rank = -1;
+
etype = gfc_get_element_type (TREE_TYPE (descr));
gfc_conv_descriptor_dtype_set (block, descr,
-gfc_get_dtype_rank_type (as->rank, etype));
+gfc_get_dtype_rank_type (rank, etype));
+}
+
+
+void
+gfc_init_descriptor_variable (stmtblock_t *block, gfc_symbol *sym, tree descr)
+{
+ return gfc_init_descriptor_variable (block, sym, nullptr, descr);
}
@@ -748,3 +764,10 @@ gfc_build_default_class_descriptor (const gfc_typespec
&ts, tree class_type)
return gfc_class_set_static_fields (class_type, vptr, tmp);
}
+
+void
+gfc_init_absent_descriptor (stmtblock_t *block, tree descr)
+{
+ gfc_conv_descriptor_data_set (block, descr, null_pointer_node);
+}
+
diff --git a/gcc/fortran/trans-descriptor.h b/gcc/fortran/trans-descriptor.h
index f28565d783ee..de57a8e606e8 100644
--- a/gcc/fortran/trans-descriptor.h
+++ b/gcc/fortran/trans-descriptor.h
@@ -20,7 +20,6 @@ along with GCC; see the file COPYING3. If not see
#define GFC_TRANS_DESCRIPTOR_H
/* Build a null array descriptor constructor. */
-tree gfc_build_null_descriptor (tree);
tree gfc_build_default_class_descriptor (const gfc_typespec &, tree);
void gfc_nullify_descriptor (stmtblock_t *block, gfc_expr *, tree);
void gfc_set_scalar_null_descriptor (stmtblock_t *block, tree, gfc_symbol *,
gfc_expr *, tree);
@@ -97,5 +96,6 @@ gfc_get_descriptor_offsets_for_info (const_tree desc_type,
tree *data_off,
void gfc_init_descriptor_variable (stmtblock_t *block, gfc_symbol *sym, tree
descr);
void gfc_init_descriptor_result (stmtblock_t *block, tree descr);
void gfc_init_static_descriptor (tree descr);
+void gfc_init_absent_descriptor (stmtblock_t *block, tree descr);
#endif /* GFC_TRANS_DESCRIPTOR_H */
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 868566d8d8d5..6521c08e01f3 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -999,10 +999,9 @@ gfc_conv_derived_to_class (gfc_se *parmse, gfc_expr *e,
gfc_symbol *fsym,
tmp = gfc_finish_block (&block);
gfc_init_block (&block);
- gfc_conv_descriptor_data_set (&block, ctree, null_pointer_node);
+ gfc_init_absent_descriptor (&block, ctree);
if (derived_array && *derived_array != NULL_TREE)
- gfc_conv_descriptor_data_set (&block, *derived_array,
- null_pointer_node);
+ gfc_init_absent_descriptor (&block, *derived_array);
tmp = build3_v (COND_EXPR, cond_optional, tmp,
gfc_finish_block (&block));
[gcc(refs/users/mikael/heads/refactor_descriptor_v08)] Appel méthode shift descriptor dans gfc_trans_pointer_assignment
https://gcc.gnu.org/g:cd16c97854d76011df01962a422dc0b0f435a296
commit cd16c97854d76011df01962a422dc0b0f435a296
Author: Mikael Morin
Date: Wed Jul 16 15:07:58 2025 +0200
Appel méthode shift descriptor dans gfc_trans_pointer_assignment
Diff:
---
gcc/fortran/trans-descriptor.cc | 92 +
gcc/fortran/trans-descriptor.h | 1 +
gcc/fortran/trans-expr.cc | 28 +
3 files changed, 95 insertions(+), 26 deletions(-)
diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index f323453a2bae..aad233cc7f1a 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -880,3 +880,95 @@ gfc_conv_shift_descriptor (stmtblock_t* block, tree desc,
int rank)
gfc_index_one_node);
}
+
+static void
+conv_shift_descriptor (stmtblock_t *block, tree desc, int rank,
+ gfc_expr * const (lbound[GFC_MAX_DIMENSIONS]))
+{
+ /* Apply a shift of the lbound when supplied. */
+ for (int dim = 0; dim < rank; ++dim)
+{
+ gfc_expr *lb_expr = lbound[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,
+ 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-descriptor.h b/gcc/fortran/trans-descriptor.h
index 9f5851b1def0..f8492c23d793 100644
--- a/gcc/fortran/trans-descriptor.h
+++ b/gcc/fortran/trans-descriptor.h
@@ -100,5 +100,6 @@ void gfc_set_scalar_descriptor (stmtblock_t *, tree, tree);
void gfc_nullify_descriptor (stmtblock_t *, gfc_expr *, tree, tree);
void gfc_conv_shift_descriptor_lbound (stmtblock_t *, tree, int, tree);
void gfc_conv_shift_descriptor (stmtblock_t *, tree, int);
+void gfc_conv_shift_descriptor (stmtblock_t *, tree, const gfc_array_ref &);
#endif /* GFC_TRANS_DESCRIPTOR_H */
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 529bbf9c41f4..b39186d1ab57 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -11328,32 +11328,8 @@ gfc_trans_pointer_assignment (gfc_expr * expr1,
gfc_expr * expr2)
}
}
else
- {
- /* Bounds remapping. Just shift the lower bounds. */
-
- gcc_assert (expr1->rank == expr2->rank);
-
- for (dim = 0; dim < remap->u.ar.dimen; ++dim)
- {
- gfc_se lbound_se;
-
- gcc_assert (!remap->u.ar.end[dim]);
- gfc_init_se (&lbound_se, NULL);
- if (remap->u.ar.start[dim])
- {
- gfc_conv_expr (&lbound_se, remap->u.ar.start[dim]);
- gfc_add_block_to_block (&block, &lbound_se.pre);
- }
- else
- /* This remap arises from a target that is not a whole
- array. The start expressions will be NULL but we need
- the lbounds to be one. */
- lbound_se.expr = gfc_index_one_node;
- gfc_conv_shift_descriptor_lbound (&block, desc,
- dim, lbound_se.expr);
- gfc_add_block_t
[gcc(refs/users/mikael/heads/refactor_descriptor_v08)] Introduction gfc_init_descriptor_result
https://gcc.gnu.org/g:4366c6537a3cb85db1b4d07cdef4a3daae1d62aa
commit 4366c6537a3cb85db1b4d07cdef4a3daae1d62aa
Author: Mikael Morin
Date: Sat Jul 19 15:55:36 2025 +0200
Introduction gfc_init_descriptor_result
Revert "Suppression gfc_init_descriptor_result"
This reverts commit 0f85f1e92970d2a0f13dc61a9781323f33a3b631.
Diff:
---
gcc/fortran/trans-decl.cc | 4 +---
gcc/fortran/trans-descriptor.cc | 8
gcc/fortran/trans-descriptor.h | 1 +
3 files changed, 10 insertions(+), 3 deletions(-)
diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc
index bbe65e342a0e..1bf1a9a76acb 100644
--- a/gcc/fortran/trans-decl.cc
+++ b/gcc/fortran/trans-decl.cc
@@ -4787,14 +4787,12 @@ 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_init_descriptor_result (&init, tmp);
gfc_add_init_cleanup (block, gfc_finish_block (&init), NULL_TREE);
}
}
diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index cc25347551a6..27c85d4e73c1 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -698,3 +698,11 @@ gfc_init_descriptor_variable (stmtblock_t *block,
gfc_symbol *sym, tree descr)
gfc_conv_descriptor_dtype_set (block, descr,
gfc_get_dtype_rank_type (as->rank, etype));
}
+
+
+void
+gfc_init_descriptor_result (stmtblock_t *block, tree descr)
+{
+ gfc_conv_descriptor_data_set (block, descr, null_pointer_node);
+}
+
diff --git a/gcc/fortran/trans-descriptor.h b/gcc/fortran/trans-descriptor.h
index 6058f54fc5fd..0b6540116452 100644
--- a/gcc/fortran/trans-descriptor.h
+++ b/gcc/fortran/trans-descriptor.h
@@ -93,5 +93,6 @@ gfc_get_descriptor_offsets_for_info (const_tree desc_type,
tree *data_off,
tree *upper_suboff);
void gfc_init_descriptor_variable (stmtblock_t *block, gfc_symbol *sym, tree
descr);
+void gfc_init_descriptor_result (stmtblock_t *block, tree descr);
#endif /* GFC_TRANS_DESCRIPTOR_H */
[gcc(refs/users/mikael/heads/refactor_descriptor_v08)] Factorisation gfc_conv_shift_descriptor
https://gcc.gnu.org/g:8011a42ca387a30dc5ccb93ad2b67a303f6e35b4
commit 8011a42ca387a30dc5ccb93ad2b67a303f6e35b4
Author: Mikael Morin
Date: Fri Jul 18 14:45:07 2025 +0200
Factorisation gfc_conv_shift_descriptor
Factorisation gfc_conv_shift_descriptor
Diff:
---
gcc/fortran/trans-expr.cc | 7 +--
gcc/fortran/trans-stmt.cc | 6 +-
2 files changed, 2 insertions(+), 11 deletions(-)
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 3081a7fcc3a3..fe2e9f6475fc 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -1153,7 +1153,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
@@ -1221,11 +1220,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)
{
diff --git a/gcc/fortran/trans-stmt.cc b/gcc/fortran/trans-stmt.cc
index 07d42d293c6e..ddd0a120229c 100644
--- a/gcc/fortran/trans-stmt.cc
+++ b/gcc/fortran/trans-stmt.cc
@@ -2172,16 +2172,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_v08)] Suppression set_dtype_for_unallocated
https://gcc.gnu.org/g:78e0108a1c7a58b5511a29c28c7a12aaef58fcd2
commit 78e0108a1c7a58b5511a29c28c7a12aaef58fcd2
Author: Mikael Morin
Date: Wed Jul 16 12:40:12 2025 +0200
Suppression set_dtype_for_unallocated
Correction null_actual_6 et null_actual_7
Diff:
---
gcc/fortran/trans-descriptor.cc | 23 +++-
gcc/fortran/trans-expr.cc | 78 -
2 files changed, 36 insertions(+), 65 deletions(-)
diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index 2d48a1834ba1..785e81757bd1 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -625,6 +625,27 @@ gfc_build_null_descriptor (tree type)
return tmp;
}
+tree
+build_static_descriptor_init (tree type)
+{
+ vec *v = NULL;
+
+ gcc_assert (GFC_DESCRIPTOR_TYPE_P (type));
+ tree fields = TYPE_FIELDS (type);
+
+ /* Set a NULL data pointer. */
+ tree field = gfc_advance_chain (fields, DATA_FIELD);
+ CONSTRUCTOR_APPEND_ELT (v, field, null_pointer_node);
+
+ field = gfc_advance_chain (fields, DTYPE_FIELD);
+ CONSTRUCTOR_APPEND_ELT (v, field, gfc_get_dtype (type));
+
+ tree tmp = build_constructor (type, v);
+ TREE_CONSTANT (tmp) = 1;
+ /* All other fields are ignored. */
+
+ return tmp;
+}
/* Obtain offsets for trans-types.cc(gfc_get_array_descr_info). */
@@ -736,7 +757,7 @@ void
gfc_init_static_descriptor (tree descr)
{
tree type = TREE_TYPE (descr);
- DECL_INITIAL (descr) = gfc_build_null_descriptor (type);
+ DECL_INITIAL (descr) = build_static_descriptor_init (type);
}
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 160774c33959..0a442d09418a 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -6018,50 +6018,6 @@ expr_may_alias_variables (gfc_expr *e, bool
array_may_alias)
}
-/* A helper function to set the dtype for unallocated or unassociated
- entities. */
-
-static void
-set_dtype_for_unallocated (gfc_se *parmse, gfc_expr *e)
-{
- tree tmp;
- tree desc;
- tree cond;
- tree type;
- stmtblock_t block;
-
- /* TODO Figure out how to handle optional dummies. */
- if (e && e->expr_type == EXPR_VARIABLE
- && e->symtree->n.sym->attr.optional)
-return;
-
- desc = parmse->expr;
- if (desc == NULL_TREE)
-return;
-
- if (POINTER_TYPE_P (TREE_TYPE (desc)))
-desc = build_fold_indirect_ref_loc (input_location, desc);
- if (GFC_CLASS_TYPE_P (TREE_TYPE (desc)))
-desc = gfc_class_data_get (desc);
- if (!GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (desc)))
-return;
-
- gfc_init_block (&block);
- tmp = gfc_conv_descriptor_data_get (desc);
- cond = fold_build2_loc (input_location, EQ_EXPR,
- logical_type_node, tmp,
- build_int_cst (TREE_TYPE (tmp), 0));
- type = gfc_get_element_type (TREE_TYPE (desc));
- gfc_conv_descriptor_dtype_set (&block, desc,
-gfc_get_dtype_rank_type (e->rank, type));
- cond = build3_v (COND_EXPR, cond,
- gfc_finish_block (&block),
- build_empty_stmt (input_location));
- gfc_add_expr_to_block (&parmse->pre, cond);
-}
-
-
-
/* Provide an interface between gfortran array descriptors and the F2018:18.4
ISO_Fortran_binding array descriptors. */
@@ -7889,26 +7845,20 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
&& CLASS_DATA (fsym)->as->type == AS_ASSUMED_RANK)
: (fsym->as && fsym->as->type == AS_ASSUMED_RANK)))
{
- if (fsym->ts.type == BT_CLASS
- ? (CLASS_DATA (fsym)->attr.class_pointer
-|| CLASS_DATA (fsym)->attr.allocatable)
- : (fsym->attr.pointer || fsym->attr.allocatable))
- {
- /* Unallocated allocatable arrays and unassociated pointer
-arrays need their dtype setting if they are argument
-associated with assumed rank dummies to set the rank. */
- set_dtype_for_unallocated (&parmse, e);
- }
- else if (e->expr_type == EXPR_VARIABLE
- && e->symtree->n.sym->attr.dummy
- && (e->ts.type == BT_CLASS
- ? (e->ref && e->ref->next
- && e->ref->next->type == REF_ARRAY
- && e->ref->next->u.ar.type == AR_FULL
- && e->ref->next->u.ar.as->type == AS_ASSUMED_SIZE)
- : (e->ref && e->ref->type == REF_ARRAY
- && e->ref->u.ar.type == AR_FULL
- && e->ref->u.ar.as->type == AS_ASSUMED_SIZE)))
+ if (!(fsym->ts.type == BT_CLASS
+ ? (CLASS_DATA (fsym)->attr.class_pointer
+ || CLASS_DATA (fsym)->attr.allocatable)
+ : (fsym->attr.pointer || fsym->attr.allocatable))
+ && e->expr_type == EXPR_VARIABLE
+ && e->symtree->n.sym->attr.dummy
+ && (e->ts.type == BT_CLA
[gcc(refs/users/mikael/heads/refactor_descriptor_v08)] Factorisation set descriptor with shape
https://gcc.gnu.org/g:0d9698e3dc5baba7d5ad27a5ceb9b34973c1ac20
commit 0d9698e3dc5baba7d5ad27a5ceb9b34973c1ac20
Author: Mikael Morin
Date: Tue Jul 22 10:03:33 2025 +0200
Factorisation set descriptor with shape
Diff:
---
gcc/fortran/trans-descriptor.cc | 78 +
gcc/fortran/trans-descriptor.h | 2 ++
gcc/fortran/trans-intrinsic.cc | 76 +++
3 files changed, 85 insertions(+), 71 deletions(-)
diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index e8cb4831f559..aeb93eda7fc7 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -1411,3 +1411,81 @@ gfc_set_contiguous_descriptor (stmtblock_t *block, tree
desc, tree size,
gfc_index_zero_node, size);
gfc_conv_descriptor_data_set (block, desc, data_ptr);
}
+
+
+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_conv_descriptor_dtype_set (block, 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);
+}
+
diff --git a/gcc/fortran/trans-descriptor.h b/gcc/fortran/trans-descriptor.h
index 818f3f319566..b17b71b09809 100644
--- a/gcc/fortran/trans-descriptor.h
+++ b/gcc/fortran/trans-descriptor.h
@@ -119,5 +119,7 @@ gfc_set_descriptor (stmtblock_t *block, tree dest, tree
src, gfc_expr *src_expr,
bool unlimited_polymorphic, bool data_needed,
bool subref);
void gfc_set_contiguous_descriptor (stmtblock_t *, tree, tree, tree);
+void gfc_set_descriptor_with_shape (stmtblock_t *, tree, tree, gfc_expr *,
+ locus *);
#endif /* GFC_TRANS_DESCRIPTOR_H */
diff --git a/gcc/fortran/trans-intrinsic.cc b/gcc/fortran/trans-intrinsic.cc
index 314323c29c81..e863964755f7 100644
--- a/gcc/fortran/trans-intrinsic.cc
+++ b/gcc/fortran/trans-intrinsic.cc
@@ -9917,11 +9917,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;
- stmtblock_t body, block;
- gfc_loopinfo loop;
+ tree desc;
+ stmtblock_t block;
gfc_actu
[gcc(refs/users/mikael/heads/refactor_descriptor_v08)] Extraction gfc_set_gfc_from_cfi
https://gcc.gnu.org/g:9cd04072b31b9b7b4210f3abe0b1dbb672d1251a
commit 9cd04072b31b9b7b4210f3abe0b1dbb672d1251a
Author: Mikael Morin
Date: Tue Jul 22 12:17:50 2025 +0200
Extraction gfc_set_gfc_from_cfi
Diff:
---
gcc/fortran/trans-descriptor.cc | 98 +
gcc/fortran/trans-descriptor.h | 3 ++
gcc/fortran/trans-expr.cc | 92 +-
3 files changed, 102 insertions(+), 91 deletions(-)
diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index 4cc0eb2c0c58..93a15d06d3cd 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -1569,3 +1569,101 @@ gfc_set_subarray_descriptor (stmtblock_t *block, tree
descr, tree value,
}
}
+
+void
+gfc_set_gfc_from_cfi (stmtblock_t *block, tree gfc, gfc_expr *e, tree rank,
+ tree gfc_strlen, tree cfi, gfc_symbol *fsym)
+{
+ stmtblock_t block2;
+ gfc_init_block (&block2);
+ if (e->rank == 0)
+{
+ tree tmp = gfc_get_cfi_desc_base_addr (cfi);
+ gfc_add_modify (block, gfc, fold_convert (TREE_TYPE (gfc), tmp));
+}
+ else
+{
+ tree 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]);
+ 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 (&block2, gfc, tmp);
+
+ /* Calculate offset + set lbound, ubound and stride. */
+ gfc_conv_descriptor_offset_set (&block2, 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 (&block2, idx, build_int_cst (TREE_TYPE (idx), 0),
+ rank, LT_EXPR, build_int_cst (TREE_TYPE (idx), 1),
+ gfc_finish_block (&loop_body));
+}
+
+ if (e->ts.type == BT_CHARACTER && !e->ts.u.cl->length)
+{
+ tree tmp = fold_convert (gfc_charlen_type_node,
+ gfc_get_cfi_desc_elem_len (cfi));
+ if (e->ts.kind != 1)
+ tmp = fold_build2_loc (input_location, TRUNC_DIV_EXPR,
+ gfc_charlen_type_node, tmp,
+ build_int_cst (gfc_charlen_type_node,
+ e->ts.kind));
+ gfc_add_modify
[gcc(refs/users/mikael/heads/refactor_descriptor_v08)] Extraction gfc_set_temporary_descriptor
https://gcc.gnu.org/g:aaab7ec26d91a8f5fe5bbbca8213da472c44d03d
commit aaab7ec26d91a8f5fe5bbbca8213da472c44d03d
Author: Mikael Morin
Date: Wed Jul 23 12:12:01 2025 +0200
Extraction gfc_set_temporary_descriptor
Diff:
---
gcc/fortran/trans-array.cc | 62 +
gcc/fortran/trans-descriptor.cc | 54 +++
gcc/fortran/trans-descriptor.h | 3 ++
3 files changed, 76 insertions(+), 43 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 807de4f8ae32..dc13d13c32d1 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -624,13 +624,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;
@@ -638,7 +639,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
@@ -666,8 +667,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
{
@@ -675,7 +675,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
{
@@ -718,18 +718,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. */
@@ -737,6 +731,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;
}
@@ -970,6 +966,7 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t
* post, gfc_ss * ss,
gfc_ss *s;
gfc_array_info *info;
tree from[GFC_MAX_DIMENSIONS], to[GFC_MAX_DIMENSIONS];
+ tree stride[GFC_MAX_DIMENSIONS];
tree type;
tree desc;
tree tmp;
@@ -1105,13 +1102,12 @@ gfc_trans_create_temp_array (stmtblock_t * pre,
stmtblock_t * post, gfc_ss * ss,
TREE_USED (desc) = 0;
}
+ bool rank_changer = false;
if (class_expr != NULL_TREE
|| (fcn_ss && fcn_ss->info && fcn_ss->info->class_container))
{
tree class_data;
- tree dtype;
gfc_expr *expr1 = fcn_ss ? fcn_ss->info->expr : NULL;
- bool rank_changer;
/* Pick out these transformational functions because they change the rank
or shape of the first argument. This requires that the class type be
@@ -1165,17 +1161,7 @@ gfc_trans_create_temp_array (stmtblock_t * pre,
stmtblock_t * post, gfc_ss * ss,
class_data = gfc_class_data_get (tmp);
if (rank_changer)
- {
- /* Take the dtype from the class expression. */
- tree class_descr = gfc_class_data_get (class_expr);
- dtype = gfc_conv_descriptor_dtype_get (class_descr);
- gfc_conv_descriptor_dtype_set (pre, desc, dtype);
-
-
- /* These transformational functions change the rank. */
- gfc_conv_descriptor_rank_set (pre, desc, ss->loop->dimen);
- fcn_ss->info->class_container = NULL_TREE;
- }
+ fcn_ss->info->class_container = NULL_TREE;
/* Assign the new descriptor to the _data field. This allows the
vptr _copy to be used for scalarized assig
[gcc(refs/users/mikael/heads/refactor_descriptor_v08)] Extraction gfc_copy_descriptor
https://gcc.gnu.org/g:b31ddda1320f33a3ee439c3fd493fe37f8efc4d8
commit b31ddda1320f33a3ee439c3fd493fe37f8efc4d8
Author: Mikael Morin
Date: Wed Jul 23 10:48:32 2025 +0200
Extraction gfc_copy_descriptor
Diff:
---
gcc/fortran/trans-array.cc | 39 +++
gcc/fortran/trans-array.h | 2 ++
gcc/fortran/trans-descriptor.cc | 26 ++
gcc/fortran/trans-descriptor.h | 1 +
4 files changed, 36 insertions(+), 32 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 28dee67e8154..807de4f8ae32 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -788,8 +788,8 @@ innermost_ss (gfc_ss *ss)
It is different from the loop dimension in the case of a transposed array.
*/
-static int
-get_array_ref_dim_for_loop_dim (gfc_ss *ss, int loop_dim)
+int
+gfc_get_array_ref_dim_for_loop_dim (gfc_ss *ss, int loop_dim)
{
return get_scalarizer_dim_for_array_dim (innermost_ss (ss),
ss->dim[loop_dim]);
@@ -2361,7 +2361,7 @@ get_loop_upper_bound_for_array (gfc_ss *array, int
array_dim)
for (ss = array; ss; ss = ss->parent)
for (n = 0; n < ss->loop->dimen; n++)
- if (array_dim == get_array_ref_dim_for_loop_dim (ss, n))
+ if (array_dim == gfc_get_array_ref_dim_for_loop_dim (ss, n))
return &(ss->loop->to[n]);
gcc_unreachable ();
@@ -5478,7 +5478,8 @@ set_loop_bounds (gfc_loopinfo *loop)
&& INTEGER_CST_P (info->stride[dim]))
{
loop->from[n] = info->start[dim];
- mpz_set (i, cshape[get_array_ref_dim_for_loop_dim (loopspec[n], n)]);
+ int idx = gfc_get_array_ref_dim_for_loop_dim (loopspec[n], n);
+ mpz_set (i, cshape[idx]);
mpz_sub_ui (i, i, 1);
/* To = from + (size - 1) * stride. */
tmp = gfc_conv_mpz_to_tree (i, gfc_index_integer_kind);
@@ -8801,39 +8802,13 @@ gfc_conv_array_parameter (gfc_se *se, gfc_expr *expr,
bool g77,
}
else if (!ctree)
{
- tree old_field;
-
/* The original descriptor has transposed dims so we can't reuse
it directly; we have to create a new one. */
tree old_desc = tmp;
tree new_desc = gfc_create_var (TREE_TYPE (old_desc), "arg_desc");
- old_field = gfc_conv_descriptor_dtype_get (old_desc);
- gfc_conv_descriptor_dtype_set (&se->pre, new_desc, old_field);
-
- old_field = gfc_conv_descriptor_offset_get (old_desc);
- gfc_conv_descriptor_offset_set (&se->pre, new_desc, old_field);
-
- for (int i = 0; i < expr->rank; i++)
- {
- int idx = get_array_ref_dim_for_loop_dim (ss, i);
- old_field = gfc_conv_descriptor_dimension_get (old_desc, idx);
- gfc_conv_descriptor_dimension_set (&se->pre, new_desc, i,
-old_field);
-
- }
-
- if (flag_coarray == GFC_FCOARRAY_LIB
- && GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (old_desc))
- && GFC_TYPE_ARRAY_AKIND (TREE_TYPE (old_desc))
-== GFC_ARRAY_ALLOCATABLE)
- {
- old_field = gfc_conv_descriptor_token (old_desc);
- gfc_conv_descriptor_token_set (&se->pre, new_desc,
-old_field);
- }
-
- gfc_conv_descriptor_data_set (&se->pre, new_desc, ptr);
+ gfc_copy_descriptor (&se->pre, new_desc, old_desc, ptr,
+ expr->rank, ss);
se->expr = gfc_build_addr_expr (NULL_TREE, new_desc);
}
gfc_free_ss (ss);
diff --git a/gcc/fortran/trans-array.h b/gcc/fortran/trans-array.h
index 1d737fc2efa9..66e11d9d1f16 100644
--- a/gcc/fortran/trans-array.h
+++ b/gcc/fortran/trans-array.h
@@ -189,3 +189,5 @@ void gfc_trans_string_copy (stmtblock_t *, tree, tree, int,
tree, tree, int);
/* Calculate extent / size of an array. */
tree gfc_conv_array_extent_dim (tree, tree, tree*);
+int gfc_get_array_ref_dim_for_loop_dim (gfc_ss *, int);
+
diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index 22e5cbed8a65..b36ec15f5fda 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -1922,3 +1922,29 @@ gfc_set_descriptor_from_scalar (stmtblock_t *block, tree
descr, tree scalar)
}
+
+void
+gfc_copy_descriptor (stmtblock_t *block, tree dest, tree src, tree ptr,
+int rank, gfc_ss *ss)
+{
+ gfc_conv_descriptor_dtype_set (block, dest,
+gfc_conv_descriptor_dtype_get (src));
+
+ gfc_conv_descriptor_offset_set (block, dest,
+ gfc_conv_descriptor_offset_get (src));
+
+ for (int i = 0; i < rank;
[gcc(refs/users/mikael/heads/refactor_descriptor_v08)] Extraction gfc_set_descriptor_from_scalar
https://gcc.gnu.org/g:c7a06506e9a846bbdf0a67366f3afb9b87321b29
commit c7a06506e9a846bbdf0a67366f3afb9b87321b29
Author: Mikael Morin
Date: Tue Jul 22 21:03:11 2025 +0200
Extraction gfc_set_descriptor_from_scalar
Diff:
---
gcc/fortran/trans-descriptor.cc | 20
gcc/fortran/trans-descriptor.h | 2 ++
gcc/fortran/trans-expr.cc | 16 ++--
3 files changed, 24 insertions(+), 14 deletions(-)
diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index 6995eb1da052..cef609e0464b 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -1882,3 +1882,23 @@ gfc_set_descriptor_from_scalar (stmtblock_t *block, tree
descr,
gfc_conv_descriptor_data_set (block, descr, tmp);
}
+
+void
+gfc_set_descriptor_from_scalar (stmtblock_t *block, tree descr,
+ tree scalar, gfc_expr *scalar_expr,
+ tree cond_presence)
+{
+ tree type;
+ type = gfc_get_scalar_to_descriptor_type (scalar,
+ gfc_expr_attr (scalar_expr));
+ gfc_conv_descriptor_dtype_set (block, descr,
+gfc_get_dtype (type));
+ if (cond_presence)
+scalar = build3_loc (input_location, COND_EXPR,
+TREE_TYPE (scalar),
+cond_presence, scalar,
+fold_convert (TREE_TYPE (scalar),
+ null_pointer_node));
+ gfc_conv_descriptor_data_set (block, descr, scalar);
+}
+
diff --git a/gcc/fortran/trans-descriptor.h b/gcc/fortran/trans-descriptor.h
index 0e87eee39b38..32b045ac8c1b 100644
--- a/gcc/fortran/trans-descriptor.h
+++ b/gcc/fortran/trans-descriptor.h
@@ -128,5 +128,7 @@ void gfc_set_gfc_from_cfi (stmtblock_t *, tree, gfc_expr *,
tree, tree,
void gfc_set_gfc_from_cfi (stmtblock_t *, stmtblock_t *, tree, tree, tree,
gfc_symbol *, bool);
void gfc_set_descriptor_from_scalar (stmtblock_t *, tree, tree, gfc_expr *);
+void gfc_set_descriptor_from_scalar (stmtblock_t *, tree, tree, gfc_expr *,
+tree);
#endif /* GFC_TRANS_DESCRIPTOR_H */
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 95465cec1c02..e0115c953de0 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -959,20 +959,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)
- {
- tree type;
- type = gfc_get_scalar_to_descriptor_type (parmse->expr,
- gfc_expr_attr (e));
- gfc_conv_descriptor_dtype_set (&parmse->pre, 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);
- }
+ gfc_set_descriptor_from_scalar (&parmse->pre, ctree,
+ parmse->expr, e, cond_optional);
else
{
tmp = fold_convert (TREE_TYPE (ctree), parmse->expr);
[gcc(refs/users/mikael/heads/refactor_descriptor_v08)] Déplacement gfc_array_init_count -> gfc_descriptor_init_count
https://gcc.gnu.org/g:a0817c915cb63bdd61cb8d04fc2ff01e3b86f675
commit a0817c915cb63bdd61cb8d04fc2ff01e3b86f675
Author: Mikael Morin
Date: Thu Jul 31 16:51:20 2025 +0200
Déplacement gfc_array_init_count -> gfc_descriptor_init_count
Diff:
---
gcc/fortran/trans-array.cc | 301 ++--
gcc/fortran/trans-descriptor.cc | 283 +
gcc/fortran/trans-descriptor.h | 5 +
3 files changed, 297 insertions(+), 292 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 647a8d814b71..bce0fe519070 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -5814,289 +5814,6 @@ 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.
- {
-stride = 1;
-offset = 0;
-for (n = 0; n < rank; n++)
- {
- a.lbound[n] = specified_lower_bound;
- offset = offset + a.lbond[n] * stride;
- size = 1 - lbound;
- a.ubound[n] = specified_upper_bound;
- a.stride[n] = stride;
- size = size >= 0 ? ubound + size : 0; //size = ubound + 1 - lbound
- overflow += size == 0 ? 0: (MAX/size < stride ? 1: 0);
- stride = stride * size;
- }
-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);
- } */
-/*GCC ARRAYS*/
-
-static tree
-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 cond;
- gfc_expr *ubound;
- gfc_se se;
- int n;
-
- type = TREE_TYPE (descriptor);
-
- stride = gfc_index_one_node;
- offset = gfc_index_zero_node;
-
- /* Set the dtype before the alloc, because registration of coarrays needs
- it initialized. */
- if (expr->ts.type == BT_CHARACTER
- && expr->ts.deferred
- && VAR_P (expr->ts.u.cl->backend_decl))
-{
- type = gfc_typenode_for_spec (&expr->ts);
- gfc_conv_descriptor_dtype_set (pblock, descriptor,
-gfc_get_dtype_rank_type (rank, type));
-}
- else if (expr->ts.type == BT_CHARACTER
- && expr->ts.deferred
- && TREE_CODE (descriptor) == COMPONENT_REF)
-{
- /* Deferred character components have their string length tucked away
-in a hidden field of the derived type. Obtain that and use it to
-set the dtype. The charlen backend decl is zero because the field
-type is zero length. */
- gfc_ref *ref;
- tmp = NULL_TREE;
- for (ref = expr->ref; ref; ref = ref->next)
- if (ref->type == REF_COMPONENT
- && gfc_deferred_strlen (ref->u.c.component, &tmp))
- break;
- gcc_assert (tmp != NULL_TREE);
- tmp = fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (tmp),
-TREE_OPERAND (descriptor, 0), tmp, NULL_TREE);
- tmp = fold_convert (gfc_charlen_type_node, tmp);
- type = gfc_get_character_type_len (expr->ts.kind, tmp);
- gfc_conv_descriptor_dtype_set (pblock, descriptor,
-gfc_get_dtype_rank_type (rank, type));
-}
- else if (expr3_desc && GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (expr3_desc)))
-gfc_conv_descriptor_dtype_set (pblock, descriptor,
- gfc_conv_descriptor_dtype_get (expr3_desc));
- else if (expr->ts.type == BT_CLASS && !explicit_ts
- && expr3 && expr3->ts.type != BT_CLASS
- && expr3_elem_size != NULL_TREE && expr3_desc == NULL_TREE)
-gfc_conv_descriptor_elem_len_set (pblock, descriptor, expr3_elem_size);
- else
-gfc_conv_descriptor_dtype_set (pblock, descriptor, gfc_get_dtype (type));
-
- tree empty_cond = logical_false_node;
-
- for (n = 0; n < rank; n++)
-{
- tree conv_lbound;
- tree conv_ubound;
-
- /* We have 3 possibilities for determining the size of the array:
-lower == NULL=> lbound = 1, ubound = upper[n]
-upper[n] = NULL => lbound = 1, ubound
[gcc(refs/users/mikael/heads/refactor_descriptor_v08)] Déplacemement plus de code gfc_set_pdt_array_descriptor
https://gcc.gnu.org/g:c41ded73c1423a598fc1ec2cd8b6a5495f0651c7
commit c41ded73c1423a598fc1ec2cd8b6a5495f0651c7
Author: Mikael Morin
Date: Thu Jul 31 15:19:35 2025 +0200
Déplacemement plus de code gfc_set_pdt_array_descriptor
Diff:
---
gcc/fortran/trans-array.cc | 19 ---
gcc/fortran/trans-descriptor.cc | 8 +++-
gcc/fortran/trans-descriptor.h | 2 +-
3 files changed, 16 insertions(+), 13 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 09f60e745e20..e1e63caa8e13 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -10140,24 +10140,21 @@ structure_alloc_comps (gfc_symbol * der_type, tree
decl, tree dest,
if (c->attr.pdt_array)
{
- tree nelts = gfc_set_pdt_array_descriptor (&fnblock, comp, c->as,
-pdt_param_list);
-
+ tree elt_size;
if (c->ts.type == BT_CLASS)
{
tmp = gfc_get_vptr_from_expr (comp);
if (POINTER_TYPE_P (TREE_TYPE (tmp)))
tmp = build_fold_indirect_ref_loc (input_location, tmp);
- tmp = gfc_vptr_size_get (tmp);
+ elt_size = gfc_vptr_size_get (tmp);
}
else
- tmp = TYPE_SIZE_UNIT (gfc_get_element_type (ctype));
- tmp = fold_convert (gfc_array_index_type, tmp);
- tree size = fold_build2_loc (input_location, MULT_EXPR,
- gfc_array_index_type, nelts, tmp);
- size = gfc_evaluate_now (size, &fnblock);
- tmp = gfc_call_malloc (&fnblock, NULL, size);
- gfc_conv_descriptor_data_set (&fnblock, comp, tmp);
+ elt_size = TYPE_SIZE_UNIT (gfc_get_element_type (ctype));
+ elt_size = fold_convert (gfc_array_index_type, elt_size);
+
+ tree size = gfc_set_pdt_array_descriptor (&fnblock, comp, c->as,
+ pdt_param_list,
+ elt_size);
if (c->initializer && c->initializer->rank)
{
diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index 01fda43a0027..8ef357bd5196 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -2278,7 +2278,7 @@ gfc_set_descriptor_for_assign_realloc (stmtblock_t
*block, gfc_loopinfo *loop,
tree
gfc_set_pdt_array_descriptor (stmtblock_t *block, tree descr,
gfc_array_spec *as,
- gfc_actual_arglist *pdt_param_list)
+ gfc_actual_arglist *pdt_param_list, tree elt_size)
{
gfc_se tse;
tree size = gfc_index_one_node;
@@ -2321,5 +2321,11 @@ gfc_set_pdt_array_descriptor (stmtblock_t *block, tree
descr,
gfc_conv_descriptor_dtype_set (block, descr,
gfc_get_dtype (TREE_TYPE (descr)));
+ size = fold_build2_loc (input_location, MULT_EXPR,
+ gfc_array_index_type, size, elt_size);
+ size = gfc_evaluate_now (size, block);
+ gfc_conv_descriptor_data_set (block, descr,
+ gfc_call_malloc (block, NULL, size));
+
return size;
}
diff --git a/gcc/fortran/trans-descriptor.h b/gcc/fortran/trans-descriptor.h
index 7c14862bd76d..4f12abe5f544 100644
--- a/gcc/fortran/trans-descriptor.h
+++ b/gcc/fortran/trans-descriptor.h
@@ -143,6 +143,6 @@ void gfc_set_descriptor_for_assign_realloc (stmtblock_t *,
gfc_loopinfo *,
gfc_expr *, gfc_expr *, tree, tree,
tree, tree, bool);
tree gfc_set_pdt_array_descriptor (stmtblock_t *, tree, gfc_array_spec *,
- gfc_actual_arglist *);
+ gfc_actual_arglist *, tree);
#endif /* GFC_TRANS_DESCRIPTOR_H */
[gcc(refs/users/mikael/heads/refactor_descriptor_v08)] Extraction gfc_set_descriptor_from_scalar
https://gcc.gnu.org/g:d5a26d5d8fa2a9a0ca4ffe5ede86e7596ec74b14
commit d5a26d5d8fa2a9a0ca4ffe5ede86e7596ec74b14
Author: Mikael Morin
Date: Tue Jul 22 21:14:56 2025 +0200
Extraction gfc_set_descriptor_from_scalar
Correction code en doublon
Diff:
---
gcc/fortran/trans-descriptor.cc | 17 +
gcc/fortran/trans-descriptor.h | 1 +
gcc/fortran/trans-expr.cc | 14 +++---
3 files changed, 21 insertions(+), 11 deletions(-)
diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index cef609e0464b..a9469c639ae4 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -1902,3 +1902,20 @@ gfc_set_descriptor_from_scalar (stmtblock_t *block, tree
descr,
gfc_conv_descriptor_data_set (block, descr, scalar);
}
+
+void
+gfc_set_descriptor_from_scalar (stmtblock_t *block, tree descr, tree scalar)
+{
+ tree etype = TREE_TYPE (scalar);
+ 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_conv_descriptor_dtype_set (block, descr,
+gfc_get_dtype_rank_type (0, etype));
+ gfc_conv_descriptor_data_set (block, descr, scalar);
+ gfc_conv_descriptor_span_set (block, descr,
+ gfc_conv_descriptor_elem_len_get (descr));
+}
+
diff --git a/gcc/fortran/trans-descriptor.h b/gcc/fortran/trans-descriptor.h
index 32b045ac8c1b..7e6e2871bc5e 100644
--- a/gcc/fortran/trans-descriptor.h
+++ b/gcc/fortran/trans-descriptor.h
@@ -127,6 +127,7 @@ void gfc_set_gfc_from_cfi (stmtblock_t *, tree, gfc_expr *,
tree, tree,
tree, gfc_symbol *);
void gfc_set_gfc_from_cfi (stmtblock_t *, stmtblock_t *, tree, tree, tree,
gfc_symbol *, bool);
+void gfc_set_descriptor_from_scalar (stmtblock_t *, tree, tree);
void gfc_set_descriptor_from_scalar (stmtblock_t *, tree, tree, gfc_expr *);
void gfc_set_descriptor_from_scalar (stmtblock_t *, tree, tree, gfc_expr *,
tree);
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index e0115c953de0..88fda9047eac 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -144,10 +144,9 @@ gfc_conv_null_array_descriptor (gfc_se *se, gfc_symbol
*sym, gfc_expr *expr)
tree
gfc_conv_scalar_to_descriptor (gfc_se *se, tree scalar, symbol_attribute attr)
{
- tree desc, type, etype;
+ tree desc, type;
type = gfc_get_scalar_to_descriptor_type (scalar, attr);
- etype = TREE_TYPE (scalar);
desc = gfc_create_var (type, "desc");
DECL_ARTIFICIAL (desc) = 1;
@@ -158,15 +157,8 @@ 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_conv_descriptor_dtype_set (&se->pre, 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_get (desc));
+
+ gfc_set_descriptor_from_scalar (&se->pre, desc, scalar);
/* Copy pointer address back - but only if it could have changed and
if the actual argument is a pointer and not, e.g., NULL(). */
[gcc(refs/users/mikael/heads/refactor_descriptor_v08)] Extraction get_array_memory_size
https://gcc.gnu.org/g:05877f1396371864d32927500e45fc32955f5b22
commit 05877f1396371864d32927500e45fc32955f5b22
Author: Mikael Morin
Date: Wed Jul 23 22:21:15 2025 +0200
Extraction get_array_memory_size
Diff:
---
gcc/fortran/trans-array.cc | 155 -
1 file changed, 84 insertions(+), 71 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 24f4d9695a0f..f895c3c7e286 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -5782,6 +5782,63 @@ 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)
+{
+ 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. */
+ tree tmp = fold_build2_loc (input_location, TRUNC_DIV_EXPR,
+ size_type_node, TYPE_MAX_VALUE (size_type_node),
+ element_size);
+ tree 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);
+
+ tree 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);
+
+ tree var = gfc_create_var (TREE_TYPE (size), "size");
+
+ stmtblock_t thenblock;
+ gfc_start_block (&thenblock);
+ gfc_add_modify (&thenblock, var, build_int_cst (size_type_node, 0));
+ tree thencase = gfc_finish_block (&thenblock);
+
+ stmtblock_t elseblock;
+ gfc_start_block (&elseblock);
+ gfc_add_modify (&elseblock, var, size);
+ tree 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,
@@ -5814,25 +5871,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, 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;
@@ -5884,7 +5936,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++)
{
@@ -5980,7 +6032,7 @@ gfc_array_init_size (tree descriptor, int rank, int
corank, gfc_expr ** lower,
gfc_rank_cst[n], stride);
/* Calculate size and check whether extent i
[gcc(refs/users/mikael/heads/refactor_descriptor_v08)] Extraction gfc_set_descriptor_from_scalar
https://gcc.gnu.org/g:4caa6ff7fed2fde8996026ff69c8475737df48e1
commit 4caa6ff7fed2fde8996026ff69c8475737df48e1
Author: Mikael Morin
Date: Tue Jul 22 20:50:41 2025 +0200
Extraction gfc_set_descriptor_from_scalar
Diff:
---
gcc/fortran/trans-descriptor.cc | 18 ++
gcc/fortran/trans-descriptor.h | 1 +
gcc/fortran/trans-expr.cc | 42 +
gcc/fortran/trans-types.cc | 22 +
gcc/fortran/trans-types.h | 1 +
5 files changed, 47 insertions(+), 37 deletions(-)
diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index e5fe8973b7b3..6995eb1da052 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -1864,3 +1864,21 @@ gfc_set_gfc_from_cfi (stmtblock_t *block, stmtblock_t
*block2, tree gfc_desc,
rank, LT_EXPR, build_int_cst (TREE_TYPE (idx), 1),
gfc_finish_block (&loop_body));
}
+
+
+void
+gfc_set_descriptor_from_scalar (stmtblock_t *block, tree descr,
+ tree scalar, gfc_expr *scalar_expr)
+{
+ tree type = gfc_get_scalar_to_descriptor_type (scalar,
+gfc_expr_attr (scalar_expr));
+ gfc_conv_descriptor_dtype_set (block, descr,
+gfc_get_dtype (type));
+
+ 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, descr, tmp);
+}
+
diff --git a/gcc/fortran/trans-descriptor.h b/gcc/fortran/trans-descriptor.h
index b4fa7eed6a36..0e87eee39b38 100644
--- a/gcc/fortran/trans-descriptor.h
+++ b/gcc/fortran/trans-descriptor.h
@@ -127,5 +127,6 @@ void gfc_set_gfc_from_cfi (stmtblock_t *, tree, gfc_expr *,
tree, tree,
tree, gfc_symbol *);
void gfc_set_gfc_from_cfi (stmtblock_t *, stmtblock_t *, tree, tree, tree,
gfc_symbol *, bool);
+void gfc_set_descriptor_from_scalar (stmtblock_t *, tree, tree, gfc_expr *);
#endif /* GFC_TRANS_DESCRIPTOR_H */
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index a1a07cabe4a0..95465cec1c02 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -91,33 +91,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, 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;
@@ -167,7 +146,7 @@ gfc_conv_scalar_to_descriptor (gfc_se *se, tree scalar,
symbol_attribute attr)
{
tree desc, type, etype;
- type = get_scalar_to_descriptor_type (scalar, attr);
+ type = gfc_get_scalar_to_descriptor_type (scalar, attr);
etype = TREE_TYPE (scalar);
desc = gfc_create_var (type, "desc");
DECL_ARTIFICIAL (desc) = 1;
@@ -982,8 +961,8 @@ gfc_conv_derived_to_class (gfc_se *parmse, gfc_expr *e,
gfc_symbol *fsym,
if (fsym->ts.u.derived->components->as)
{
tree type;
- type = get_scalar_to_descriptor_type (parmse->expr,
- gfc_expr_attr (e));
+ type = gfc_get_scalar_to_descriptor_type (parmse->expr,
+ gfc_expr_attr (e));
gfc_conv_descriptor_dtype_set (&parmse->pre, ctree,
gfc_get_dtype (type));
if (optional)
@@ -1368,18 +1347,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_conv_descriptor_dtype_set (&block, 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, ctr
[gcc(refs/users/mikael/heads/refactor_descriptor_v08)] Extraction gfc_shift_descriptor
https://gcc.gnu.org/g:e3f99dc6ce137049a7061d891b21b304ce8b7926
commit e3f99dc6ce137049a7061d891b21b304ce8b7926
Author: Mikael Morin
Date: Wed Jul 23 14:59:35 2025 +0200
Extraction gfc_shift_descriptor
Diff:
---
gcc/fortran/trans-descriptor.cc | 31 +++
gcc/fortran/trans-descriptor.h | 2 ++
gcc/fortran/trans-expr.cc | 39 ++-
3 files changed, 35 insertions(+), 37 deletions(-)
diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index bc7f951bb528..ac426dd9677b 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -2002,3 +2002,34 @@ gfc_set_temporary_descriptor (stmtblock_t *block, tree
descr, tree class_src,
gfc_conv_descriptor_data_set (block, descr, data_ptr);
}
+
+void
+gfc_shift_descriptor (stmtblock_t *block, tree descr, 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 (descr, 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, descr, gfc_rank_cst[n], tmp);
+ gfc_conv_descriptor_lbound_set (block, descr, 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 = fold_build2_loc (input_location, MINUS_EXPR,
+gfc_array_index_type, ubound[n], lbound[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 (block, descr, offset);
+}
diff --git a/gcc/fortran/trans-descriptor.h b/gcc/fortran/trans-descriptor.h
index 0ec506686b93..ccb6d3c048da 100644
--- a/gcc/fortran/trans-descriptor.h
+++ b/gcc/fortran/trans-descriptor.h
@@ -135,5 +135,7 @@ void gfc_copy_descriptor (stmtblock_t *, tree, tree, tree,
int, gfc_ss *);
void gfc_set_temporary_descriptor (stmtblock_t *, tree, tree, tree, tree,
tree [GFC_MAX_DIMENSIONS],
tree [GFC_MAX_DIMENSIONS], int, bool, bool);
+void gfc_shift_descriptor (stmtblock_t *, tree, int, tree [GFC_MAX_DIMENSIONS],
+ tree [GFC_MAX_DIMENSIONS]);
#endif /* GFC_TRANS_DESCRIPTOR_H */
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index b9c8e8748f59..d73ecc08842b 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -5386,7 +5386,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;
@@ -5627,42 +5626,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
[gcc(refs/users/mikael/heads/refactor_descriptor_v08)] Mise à jour offset & span dans gfc_array_init_size
https://gcc.gnu.org/g:7678d3467841659e7f3723ac79d19ba9183002b0
commit 7678d3467841659e7f3723ac79d19ba9183002b0
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 | 30 ++
1 file changed, 10 insertions(+), 20 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index c639659cd698..24f4d9695a0f 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -5814,8 +5814,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, gfc_expr *expr3, tree expr3_desc,
bool e3_has_nodescriptor, gfc_expr *expr,
@@ -6058,6 +6058,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);
+
stride = fold_convert (size_type_node, stride);
/* First check for overflow. Since an array of type character can
@@ -6084,12 +6090,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))
@@ -6151,7 +6151,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;
@@ -6280,9 +6279,8 @@ 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, expr3, e3_arr_desc,
+ lower, upper, &se->pre, &set_descriptor_block,
+ &overflow, expr3_elem_size, expr3, e3_arr_desc,
e3_has_nodescriptor, expr, element_size,
explicit_ts);
@@ -6420,14 +6418,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_v08)] Extraction set_gfc_from_cfi
https://gcc.gnu.org/g:4539ff30f4c5b14f39ee7c48980f04f36ddf2bb6
commit 4539ff30f4c5b14f39ee7c48980f04f36ddf2bb6
Author: Mikael Morin
Date: Tue Jul 22 19:51:53 2025 +0200
Extraction set_gfc_from_cfi
Diff:
---
gcc/fortran/trans-decl.cc | 210 +++-
gcc/fortran/trans-descriptor.cc | 197 +
gcc/fortran/trans-descriptor.h | 3 +-
3 files changed, 212 insertions(+), 198 deletions(-)
diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc
index f33bff9fe0b2..6916f50a5c2e 100644
--- a/gcc/fortran/trans-decl.cc
+++ b/gcc/fortran/trans-decl.cc
@@ -7047,7 +7047,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. */
@@ -7239,98 +7239,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_conv_descriptor_dtype_set (&block, 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_conv_descriptor_elem_len_set (&block, 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));
-
- /* 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 = gfc_conv_descriptor_type_set (gfc_desc, BT_VOID);
- tmp2 = gfc_conv_descriptor_type_set (gfc_desc, 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 = gfc_conv_descriptor_type_set (gfc_desc, 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 = gfc_conv_descriptor_type_set (gfc_desc, 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),
-CFI_type_ucs4_char));
- tmp = gfc_conv_descriptor_type_set (gfc_desc, BT_CHARACTER);
- tmp2 = fold_build3_loc (input_location, COND_EXPR, void_type_node, cond,
- tmp, 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 = gfc_conv_descriptor_ty
[gcc(refs/users/mikael/heads/refactor_descriptor_v08)] Refactoring gfc_conv_descriptor_sm_get
https://gcc.gnu.org/g:23a97202c121f67a337ab9eaac343e98c32fa504
commit 23a97202c121f67a337ab9eaac343e98c32fa504
Author: Mikael Morin
Date: Tue Jul 22 11:32:27 2025 +0200
Refactoring gfc_conv_descriptor_sm_get
Diff:
---
gcc/fortran/trans-descriptor.cc | 7 +++
gcc/fortran/trans-descriptor.h | 1 +
gcc/fortran/trans-expr.cc | 6 ++
3 files changed, 10 insertions(+), 4 deletions(-)
diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index c9ecfea0dd79..4cc0eb2c0c58 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -601,6 +601,13 @@ gfc_conv_descriptor_ubound_set (stmtblock_t *block, tree
desc,
fold_convert_loc (loc, TREE_TYPE (t), value));
}
+tree
+gfc_conv_descriptor_sm_get (tree desc, tree dim)
+{
+ return fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
+ gfc_conv_descriptor_stride_get (desc, dim),
+ gfc_conv_descriptor_span_get (desc));
+}
/***
* Array descriptor higher level routines.
*
diff --git a/gcc/fortran/trans-descriptor.h b/gcc/fortran/trans-descriptor.h
index c9ad4541d970..3237265948ea 100644
--- a/gcc/fortran/trans-descriptor.h
+++ b/gcc/fortran/trans-descriptor.h
@@ -61,6 +61,7 @@ tree gfc_conv_descriptor_dimension_get (tree desc, int dim);
tree gfc_conv_descriptor_stride_get (tree desc, tree dim);
tree gfc_conv_descriptor_lbound_get (tree desc, tree dim);
tree gfc_conv_descriptor_ubound_get (tree desc, tree dim);
+tree gfc_conv_descriptor_sm_get (tree desc, tree dim);
void gfc_conv_descriptor_data_set (stmtblock_t *block, tree desc, tree value);
void gfc_conv_descriptor_data_set (stmtblock_t *block, tree desc, tree value);
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 54e7f587420e..8a2d9e6f3dd7 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -6325,10 +6325,8 @@ gfc_conv_gfc_desc_to_cfi_desc (gfc_se *parmse, gfc_expr
*e, gfc_symbol *fsym)
tmp = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
tmp, gfc_index_one_node);
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));
+ /* d->dim[n].sm = gfc->dim[i].stride * gfc->span); */
+ 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_v08)] Factorisation descriptor_element_size
https://gcc.gnu.org/g:09730ed88847ae9299141954f474c4b4ad4d9adb
commit 09730ed88847ae9299141954f474c4b4ad4d9adb
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 dc13d13c32d1..c639659cd698 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -5742,6 +5742,46 @@ gfc_conv_array_extent_dim (tree lbound, tree ubound,
tree* or_expr)
}
+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,
@@ -5779,7 +5819,7 @@ gfc_array_init_size (tree descriptor, int rank, int
corank, tree * poffset,
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 element_size, bool explicit_ts)
{
tree type;
tree tmp;
@@ -6013,37 +6053,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;
stride = fold_convert (size_type_node, stride);
@@ -6052,14 +6065,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,
@@ -6069,7 +6082,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, element_size);
if (poffset != NULL)
{
@@ -6257
[gcc(refs/users/mikael/heads/refactor_descriptor_v08)] Déplacement gfc_grow_array
https://gcc.gnu.org/g:4bfc899aa70c35b0d0fdf84c85463b9c07948f8c
commit 4bfc899aa70c35b0d0fdf84c85463b9c07948f8c
Author: Mikael Morin
Date: Thu Jul 31 14:41:23 2025 +0200
Déplacement gfc_grow_array
Diff:
---
gcc/fortran/trans-array.cc | 37 -
gcc/fortran/trans-descriptor.cc | 39 +++
gcc/fortran/trans-descriptor.h | 1 +
3 files changed, 40 insertions(+), 37 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index e1e63caa8e13..bb61a3bdc953 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -1309,43 +1309,6 @@ gfc_get_iteration_count (tree start, tree end, tree step)
}
-/* Extend the data in array DESC by EXTRA elements. */
-
-static void
-gfc_grow_array (stmtblock_t * pblock, tree desc, tree extra)
-{
- tree arg0, arg1;
- tree tmp;
- tree size;
- tree ubound;
-
- if (integer_zerop (extra))
-return;
-
- ubound = gfc_conv_descriptor_ubound_get (desc, gfc_rank_cst[0]);
-
- /* Add EXTRA to the upper bound. */
- tmp = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
-ubound, extra);
- gfc_conv_descriptor_ubound_set (pblock, desc, gfc_rank_cst[0], tmp);
-
- /* Get the value of the current data pointer. */
- arg0 = gfc_conv_descriptor_data_get (desc);
-
- /* Calculate the new array size. */
- size = TYPE_SIZE_UNIT (gfc_get_element_type (TREE_TYPE (desc)));
- tmp = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
-ubound, gfc_index_one_node);
- arg1 = fold_build2_loc (input_location, MULT_EXPR, size_type_node,
- fold_convert (size_type_node, tmp),
- fold_convert (size_type_node, size));
-
- /* Call the realloc() function. */
- tmp = gfc_call_realloc (pblock, arg0, arg1);
- gfc_conv_descriptor_data_set (pblock, desc, tmp);
-}
-
-
/* Return true if the bounds of iterator I can only be determined
at run time. */
diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index 8ef357bd5196..ff35e7cca670 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -2329,3 +2329,42 @@ gfc_set_pdt_array_descriptor (stmtblock_t *block, tree
descr,
return size;
}
+
+
+/* Extend the data in array DESC by EXTRA elements. */
+
+void
+gfc_grow_array (stmtblock_t * pblock, tree desc, tree extra)
+{
+ tree arg0, arg1;
+ tree tmp;
+ tree size;
+ tree ubound;
+
+ if (integer_zerop (extra))
+return;
+
+ ubound = gfc_conv_descriptor_ubound_get (desc, gfc_rank_cst[0]);
+
+ /* Add EXTRA to the upper bound. */
+ tmp = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
+ubound, extra);
+ gfc_conv_descriptor_ubound_set (pblock, desc, gfc_rank_cst[0], tmp);
+
+ /* Get the value of the current data pointer. */
+ arg0 = gfc_conv_descriptor_data_get (desc);
+
+ /* Calculate the new array size. */
+ size = TYPE_SIZE_UNIT (gfc_get_element_type (TREE_TYPE (desc)));
+ tmp = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
+ubound, gfc_index_one_node);
+ arg1 = fold_build2_loc (input_location, MULT_EXPR, size_type_node,
+ fold_convert (size_type_node, tmp),
+ fold_convert (size_type_node, size));
+
+ /* Call the realloc() function. */
+ tmp = gfc_call_realloc (pblock, arg0, arg1);
+ gfc_conv_descriptor_data_set (pblock, desc, tmp);
+}
+
+
diff --git a/gcc/fortran/trans-descriptor.h b/gcc/fortran/trans-descriptor.h
index 4f12abe5f544..27a700ccc1df 100644
--- a/gcc/fortran/trans-descriptor.h
+++ b/gcc/fortran/trans-descriptor.h
@@ -144,5 +144,6 @@ void gfc_set_descriptor_for_assign_realloc (stmtblock_t *,
gfc_loopinfo *,
tree, tree, bool);
tree gfc_set_pdt_array_descriptor (stmtblock_t *, tree, gfc_array_spec *,
gfc_actual_arglist *, tree);
+void gfc_grow_array (stmtblock_t *, tree, tree);
#endif /* GFC_TRANS_DESCRIPTOR_H */
[gcc(refs/users/mikael/heads/refactor_descriptor_v08)] Suppression modification span
https://gcc.gnu.org/g:f58e8e76a987ca4f4d52310e12726588d3821659
commit f58e8e76a987ca4f4d52310e12726588d3821659
Author: Mikael Morin
Date: Thu Jul 31 16:29:42 2025 +0200
Suppression modification span
Ajout test
Diff:
---
gcc/fortran/trans-expr.cc | 5 -
gcc/testsuite/gfortran.dg/pointer_assign_16.f90 | 25 +
2 files changed, 25 insertions(+), 5 deletions(-)
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 334309754330..9762918fbff8 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -10885,11 +10885,6 @@ gfc_trans_pointer_assignment (gfc_expr * expr1,
gfc_expr * expr2)
{
rse.expr = gfc_class_data_get (rse.expr);
gfc_add_modify (&lse.pre, desc, rse.expr);
- /* Set the lhs span. */
- tmp = TREE_TYPE (rse.expr);
- tmp = TYPE_SIZE_UNIT (gfc_get_element_type (tmp));
- tmp = fold_convert (gfc_array_index_type, tmp);
- gfc_conv_descriptor_span_set (&lse.pre, desc, tmp);
}
else
{
diff --git a/gcc/testsuite/gfortran.dg/pointer_assign_16.f90
b/gcc/testsuite/gfortran.dg/pointer_assign_16.f90
new file mode 100644
index ..9282283df491
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pointer_assign_16.f90
@@ -0,0 +1,25 @@
+! { dg-do run }
+!
+! Check the span of the descriptor of an array pointer after it has been
+! assigned to from a polymorphic function result.
+
+program test
+ implicit none
+ type t
+integer :: c
+ end type t
+ type, extends(t) :: u
+integer :: d
+ end type u
+ type(t), pointer :: p(:)
+ class(t), allocatable, target :: a(:)
+ p => f()
+ ! print *, p%c
+ if (any(p%c /= [2,5,11,17,23])) error stop 1
+contains
+ function f()
+class(t), pointer :: f(:)
+a = [ u(2,3), u(5,7), u(11,13), u(17,19), u(23,29) ]
+f => a
+ end function
+end program
[gcc(refs/users/mikael/heads/refactor_descriptor_v08)] Renseignement token dans gcf_set_descriptor_from_scalar
https://gcc.gnu.org/g:7b804313aa7b237746191fc7f8e448466d7e6c86
commit 7b804313aa7b237746191fc7f8e448466d7e6c86
Author: Mikael Morin
Date: Wed Jul 23 09:44:49 2025 +0200
Renseignement token dans gcf_set_descriptor_from_scalar
Diff:
---
gcc/fortran/trans-descriptor.cc | 11 +++
gcc/fortran/trans-descriptor.h | 2 +-
gcc/fortran/trans-expr.cc | 16 +++-
3 files changed, 19 insertions(+), 10 deletions(-)
diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index a9469c639ae4..22e5cbed8a65 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -1886,11 +1886,13 @@ gfc_set_descriptor_from_scalar (stmtblock_t *block,
tree descr,
void
gfc_set_descriptor_from_scalar (stmtblock_t *block, tree descr,
tree scalar, gfc_expr *scalar_expr,
- tree cond_presence)
+ tree cond_presence, tree caf_token)
{
- tree type;
- type = gfc_get_scalar_to_descriptor_type (scalar,
- gfc_expr_attr (scalar_expr));
+ if (flag_coarray == GFC_FCOARRAY_LIB && caf_token)
+gfc_conv_descriptor_token_set (block, descr, caf_token);
+
+ tree type = gfc_get_scalar_to_descriptor_type (scalar,
+gfc_expr_attr (scalar_expr));
gfc_conv_descriptor_dtype_set (block, descr,
gfc_get_dtype (type));
if (cond_presence)
@@ -1917,5 +1919,6 @@ gfc_set_descriptor_from_scalar (stmtblock_t *block, tree
descr, tree scalar)
gfc_conv_descriptor_data_set (block, descr, scalar);
gfc_conv_descriptor_span_set (block, descr,
gfc_conv_descriptor_elem_len_get (descr));
+
}
diff --git a/gcc/fortran/trans-descriptor.h b/gcc/fortran/trans-descriptor.h
index 7e6e2871bc5e..b586b9679877 100644
--- a/gcc/fortran/trans-descriptor.h
+++ b/gcc/fortran/trans-descriptor.h
@@ -130,6 +130,6 @@ void gfc_set_gfc_from_cfi (stmtblock_t *, stmtblock_t *,
tree, tree, tree,
void gfc_set_descriptor_from_scalar (stmtblock_t *, tree, tree);
void gfc_set_descriptor_from_scalar (stmtblock_t *, tree, tree, gfc_expr *);
void gfc_set_descriptor_from_scalar (stmtblock_t *, tree, tree, gfc_expr *,
-tree);
+tree, tree);
#endif /* GFC_TRANS_DESCRIPTOR_H */
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 88fda9047eac..b9c8e8748f59 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -864,6 +864,7 @@ gfc_conv_derived_to_class (gfc_se *parmse, gfc_expr *e,
gfc_symbol *fsym,
tree var;
tree tmp;
tree packed = NULL_TREE;
+ tree caf_token = NULL_TREE;
/* The derived type needs to be converted to a temporary CLASS object. */
tmp = gfc_typenode_for_spec (&fsym->ts);
@@ -880,12 +881,17 @@ gfc_conv_derived_to_class (gfc_se *parmse, gfc_expr *e,
gfc_symbol *fsym,
if (flag_coarray == GFC_FCOARRAY_LIB && CLASS_DATA (fsym)->attr.codimension)
{
- tree token;
tmp = gfc_get_tree_for_caf_expr (e);
if (POINTER_TYPE_P (TREE_TYPE (tmp)))
tmp = build_fold_indirect_ref (tmp);
- gfc_get_caf_token_offset (parmse, &token, nullptr, tmp, NULL_TREE, e);
- gfc_conv_descriptor_token_set (&parmse->pre, ctree, token);
+ gfc_get_caf_token_offset (parmse, &caf_token, nullptr, tmp, NULL_TREE,
e);
+ /* Update the token here, unless it's done elsewhere like in
+ gfc_set_descriptor_from_scalar. */
+ if ((parmse->expr && POINTER_TYPE_P (TREE_TYPE (parmse->expr)))
+ || (parmse->ss && parmse->ss->info && parmse->ss->info->useflags)
+ || e->rank != 0
+ || fsym->ts.u.derived->components->as == nullptr)
+ gfc_conv_descriptor_token_set (&parmse->pre, ctree, caf_token);
}
if (optional)
@@ -951,8 +957,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)
- gfc_set_descriptor_from_scalar (&parmse->pre, ctree,
- parmse->expr, e, cond_optional);
+ gfc_set_descriptor_from_scalar (&parmse->pre, ctree, parmse->expr,
+ e, cond_optional, caf_token);
else
{
tmp = fold_convert (TREE_TYPE (ctree), parmse->expr);
[gcc(refs/users/mikael/heads/refactor_descriptor_v08)] Extraction gfc_set_descriptor_for_assign_realloc
https://gcc.gnu.org/g:9a7375ac923271e31f0e98334eaa6547062904bc
commit 9a7375ac923271e31f0e98334eaa6547062904bc
Author: Mikael Morin
Date: Thu Jul 31 12:11:15 2025 +0200
Extraction gfc_set_descriptor_for_assign_realloc
Diff:
---
gcc/fortran/trans-array.cc | 228 ++--
gcc/fortran/trans-array.h | 1 +
gcc/fortran/trans-descriptor.cc | 216 +
gcc/fortran/trans-descriptor.h | 3 +
4 files changed, 226 insertions(+), 222 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 80e3b767ff76..f68a7467f311 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -10557,76 +10557,6 @@ gfc_check_pdt_dummy (gfc_symbol * der_type, tree decl,
int rank,
}
-/* Returns the value of LBOUND for an expression. This could be broken out
- from gfc_conv_intrinsic_bound but this seemed to be simpler. This is
- called by gfc_alloc_allocatable_for_assignment. */
-static tree
-get_std_lbound (gfc_expr *expr, tree desc, int dim, bool assumed_size)
-{
- tree lbound;
- tree ubound;
- tree stride;
- tree cond, cond1, cond3, cond4;
- tree tmp;
- gfc_ref *ref;
-
- if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (desc)))
-{
- tmp = gfc_rank_cst[dim];
- lbound = gfc_conv_descriptor_lbound_get (desc, tmp);
- ubound = gfc_conv_descriptor_ubound_get (desc, tmp);
- stride = gfc_conv_descriptor_stride_get (desc, tmp);
- cond1 = fold_build2_loc (input_location, GE_EXPR, logical_type_node,
- ubound, lbound);
- cond3 = fold_build2_loc (input_location, GE_EXPR, logical_type_node,
- stride, gfc_index_zero_node);
- cond3 = fold_build2_loc (input_location, TRUTH_AND_EXPR,
- logical_type_node, cond3, cond1);
- cond4 = fold_build2_loc (input_location, LT_EXPR, logical_type_node,
- stride, gfc_index_zero_node);
- if (assumed_size)
- cond = fold_build2_loc (input_location, EQ_EXPR, logical_type_node,
- tmp, build_int_cst (gfc_array_index_type,
- expr->rank - 1));
- else
- cond = logical_false_node;
-
- cond1 = fold_build2_loc (input_location, TRUTH_OR_EXPR,
- logical_type_node, cond3, cond4);
- cond = fold_build2_loc (input_location, TRUTH_OR_EXPR,
- logical_type_node, cond, cond1);
-
- return fold_build3_loc (input_location, COND_EXPR,
- gfc_array_index_type, cond,
- lbound, gfc_index_one_node);
-}
-
- if (expr->expr_type == EXPR_FUNCTION)
-{
- /* A conversion function, so use the argument. */
- gcc_assert (expr->value.function.isym
- && expr->value.function.isym->conversion);
- expr = expr->value.function.actual->expr;
-}
-
- if (expr->expr_type == EXPR_VARIABLE)
-{
- tmp = TREE_TYPE (expr->symtree->n.sym->backend_decl);
- for (ref = expr->ref; ref; ref = ref->next)
- {
- if (ref->type == REF_COMPONENT
- && ref->u.c.component->as
- && ref->next
- && ref->next->u.ar.type == AR_FULL)
- tmp = TREE_TYPE (ref->u.c.component->backend_decl);
- }
- return GFC_TYPE_ARRAY_LBOUND(tmp, dim);
-}
-
- return gfc_index_one_node;
-}
-
-
/* Returns true if an expression represents an lhs that can be reallocated
on assignment. */
@@ -10776,8 +10706,8 @@ concat_str_length (gfc_expr* expr)
At the end of the function, the expressions have been replaced with variable
references. */
-static void
-update_reallocated_descriptor (stmtblock_t *block, gfc_loopinfo *loop)
+void
+gfc_update_reallocated_descriptor (stmtblock_t *block, gfc_loopinfo *loop)
{
for (gfc_ss *s = loop->ss; s != gfc_ss_terminator; s = s->loop_chain)
{
@@ -10830,7 +10760,6 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo
*loop,
gfc_array_info *linfo;
tree realloc_expr;
tree alloc_expr;
- tree size1;
tree size2;
tree elemsize1;
tree elemsize2;
@@ -10838,19 +10767,15 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo
*loop,
tree cond_null;
tree cond;
tree tmp;
- tree tmp2;
tree lbound;
tree ubound;
tree desc;
tree old_desc;
tree desc2;
- tree offset;
tree jump_label1;
tree jump_label2;
- tree lbd;
tree class_expr2 = NULL_TREE;
int n;
- gfc_array_spec * as;
bool coarray = (flag_coarray == GFC_FCOARRAY_LIB
&& gfc_caf_attr (expr1, true).codimension);
tree token;
@@ -11076,20 +11001,6 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo
*loop,
build_empty_stmt (input_location));
gfc_add_expr_to_block (&fblock, tmp);
- /* Get arrayspec if expr is a full array. */
- if (expr2 && expr2->expr_type
[gcc(refs/users/mikael/heads/refactor_descriptor_v08)] Suppression mise à jour upper bound.
https://gcc.gnu.org/g:0b6cbdff0ab2ff35667481f03ca856815a96a831 commit 0b6cbdff0ab2ff35667481f03ca856815a96a831 Author: Mikael Morin Date: Mon Mar 17 19:09:18 2025 +0100 Suppression mise à jour upper bound. Diff: --- gcc/fortran/trans-array.cc | 1 - 1 file changed, 1 deletion(-) diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc index bb61a3bdc953..9a66f722e157 100644 --- a/gcc/fortran/trans-array.cc +++ b/gcc/fortran/trans-array.cc @@ -2546,7 +2546,6 @@ trans_array_constructor (gfc_ss * ss, locus * where) gfc_array_index_type, offsetvar, gfc_index_one_node); tmp = gfc_evaluate_now (tmp, &outer_loop->pre); - gfc_conv_descriptor_ubound_set (&loop->pre, desc, gfc_rank_cst[0], tmp); if (*loop_ubound0 && VAR_P (*loop_ubound0)) gfc_add_modify (&outer_loop->pre, *loop_ubound0, tmp); else
[gcc(refs/users/mikael/heads/refactor_descriptor_v08)] Suppression mise à jour offset forall
https://gcc.gnu.org/g:d79db5044eb1be4b0fb8d32e14dc9bf311ce3589
commit d79db5044eb1be4b0fb8d32e14dc9bf311ce3589
Author: Mikael Morin
Date: Mon Feb 17 17:28:01 2025 +0100
Suppression mise à jour offset forall
Sauvegarde
Correction régression forall
Diff:
---
gcc/fortran/trans-array.cc | 55 +
gcc/fortran/trans-array.h | 3 ++-
gcc/fortran/trans-descriptor.cc | 37 ++-
gcc/fortran/trans-descriptor.h | 4 ++-
gcc/fortran/trans-expr.cc | 4 ++-
gcc/fortran/trans-stmt.cc | 10 ++--
gcc/fortran/trans.h | 4 ++-
7 files changed, 78 insertions(+), 39 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index f895c3c7e286..80e3b767ff76 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -960,7 +960,8 @@ get_class_info_from_ss (stmtblock_t * pre, gfc_ss *ss, tree
*eltype,
tree
gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, gfc_ss *
ss,
tree eltype, tree initial, bool dynamic,
-bool dealloc, bool callee_alloc, locus * where)
+bool dealloc, bool callee_alloc, locus * where,
+bool shift_bounds)
{
gfc_loopinfo *loop;
gfc_ss *s;
@@ -1048,19 +1049,23 @@ gfc_trans_create_temp_array (stmtblock_t * pre,
stmtblock_t * post, gfc_ss * ss,
{
dim = s->dim[n];
- /* Callee allocated arrays may not have a known bound yet. */
- if (loop->to[n])
- loop->to[n] = gfc_evaluate_now (
- fold_build2_loc (input_location, MINUS_EXPR,
-gfc_array_index_type,
-loop->to[n], loop->from[n]),
- pre);
- loop->from[n] = gfc_index_zero_node;
+ if (shift_bounds)
+ {
+ /* Callee allocated arrays may not have a known bound yet. */
+ if (loop->to[n])
+ {
+ tree t = fold_build2_loc (input_location, MINUS_EXPR,
+ gfc_array_index_type,
+ loop->to[n], loop->from[n]);
+ loop->to[n] = gfc_evaluate_now (t, pre);
+ }
+ loop->from[n] = gfc_index_zero_node;
- /* We have just changed the loop bounds, we must clear the
-corresponding specloop, so that delta calculation is not skipped
-later in gfc_set_delta. */
- loop->specloop[n] = NULL;
+ /* We have just changed the loop bounds, we must clear the
+corresponding specloop, so that delta calculation is not
+skipped later in gfc_set_delta. */
+ loop->specloop[n] = NULL;
+ }
/* We are constructing the temporary's descriptor based on the loop
dimensions. As the dimensions may be accessed in arbitrary order
@@ -1221,13 +1226,18 @@ gfc_trans_create_temp_array (stmtblock_t * pre,
stmtblock_t * post, gfc_ss * ss,
{
stride[n] = size;
- tmp = fold_build2_loc (input_location, PLUS_EXPR,
-gfc_array_index_type,
-to[n], gfc_index_one_node);
+ tmp = gfc_index_one_node;
+ if (!shift_bounds && !integer_zerop (from[n]))
+ tmp = fold_build2_loc (input_location, MINUS_EXPR,
+ gfc_array_index_type,
+ gfc_index_one_node, from[n]);
+
+ tree extent = fold_build2_loc (input_location, PLUS_EXPR,
+gfc_array_index_type, to[n], tmp);
/* Check whether the size for this dimension is negative. */
cond = fold_build2_loc (input_location, LE_EXPR, logical_type_node,
- tmp, gfc_index_zero_node);
+ extent, gfc_index_zero_node);
cond = gfc_evaluate_now (cond, pre);
if (n == 0)
@@ -1237,7 +1247,7 @@ gfc_trans_create_temp_array (stmtblock_t * pre,
stmtblock_t * post, gfc_ss * ss,
logical_type_node, or_expr, cond);
size = fold_build2_loc (input_location, MULT_EXPR,
- gfc_array_index_type, size, tmp);
+ gfc_array_index_type, size, extent);
size = gfc_evaluate_now (size, pre);
}
}
@@ -1265,9 +1275,9 @@ gfc_trans_create_temp_array (stmtblock_t * pre,
stmtblock_t * post, gfc_ss * ss,
dealloc);
gfc_set_temporary_descriptor (pre, desc, class_expr, elemsize, data_ptr,
- to, stride, total_dim,
+ from, to, stride, total_dim,
[gcc(refs/users/mikael/heads/refactor_descriptor_v08)] Extraction gfc_set_pdt_array_descriptor
https://gcc.gnu.org/g:ab2bc5528e83490eb7afaf841f88ce754f265e4d
commit ab2bc5528e83490eb7afaf841f88ce754f265e4d
Author: Mikael Morin
Date: Thu Jul 31 12:34:22 2025 +0200
Extraction gfc_set_pdt_array_descriptor
Diff:
---
gcc/fortran/trans-array.cc | 62 +
gcc/fortran/trans-descriptor.cc | 49
gcc/fortran/trans-descriptor.h | 2 ++
3 files changed, 58 insertions(+), 55 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index f68a7467f311..09f60e745e20 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -10140,56 +10140,9 @@ structure_alloc_comps (gfc_symbol * der_type, tree
decl, tree dest,
if (c->attr.pdt_array)
{
- gfc_se tse;
- int i;
- tree size = gfc_index_one_node;
- tree offset = gfc_index_zero_node;
- tree lower, upper;
- gfc_expr *e;
-
- /* This chunk takes the expressions for 'lower' and 'upper'
-in the arrayspec and substitutes in the expressions for
-the parameters from 'pdt_param_list'. The descriptor
-fields can then be filled from the values so obtained. */
- gcc_assert (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (comp)));
- for (i = 0; i < c->as->rank; i++)
- {
- gfc_init_se (&tse, NULL);
- e = gfc_copy_expr (c->as->lower[i]);
- gfc_insert_parameter_exprs (e, pdt_param_list);
- gfc_conv_expr_type (&tse, e, gfc_array_index_type);
- gfc_free_expr (e);
- lower = tse.expr;
- gfc_conv_descriptor_lbound_set (&fnblock, comp,
- gfc_rank_cst[i],
- lower);
- e = gfc_copy_expr (c->as->upper[i]);
- gfc_insert_parameter_exprs (e, pdt_param_list);
- gfc_conv_expr_type (&tse, e, gfc_array_index_type);
- gfc_free_expr (e);
- upper = tse.expr;
- gfc_conv_descriptor_ubound_set (&fnblock, comp,
- gfc_rank_cst[i],
- upper);
- gfc_conv_descriptor_stride_set (&fnblock, comp,
- gfc_rank_cst[i],
- size);
- size = gfc_evaluate_now (size, &fnblock);
- offset = fold_build2_loc (input_location,
- MINUS_EXPR,
- gfc_array_index_type,
- offset, size);
- offset = gfc_evaluate_now (offset, &fnblock);
- tmp = fold_build2_loc (input_location, MINUS_EXPR,
-gfc_array_index_type,
-upper, lower);
- 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 (&fnblock, comp, offset);
+ tree nelts = gfc_set_pdt_array_descriptor (&fnblock, comp, c->as,
+pdt_param_list);
+
if (c->ts.type == BT_CLASS)
{
tmp = gfc_get_vptr_from_expr (comp);
@@ -10200,18 +10153,17 @@ structure_alloc_comps (gfc_symbol * der_type, tree
decl, tree dest,
else
tmp = TYPE_SIZE_UNIT (gfc_get_element_type (ctype));
tmp = fold_convert (gfc_array_index_type, tmp);
- size = fold_build2_loc (input_location, MULT_EXPR,
- gfc_array_index_type, size, tmp);
+ tree size = fold_build2_loc (input_location, MULT_EXPR,
+ gfc_array_index_type, nelts, tmp);
size = gfc_evaluate_now (size, &fnblock);
tmp = gfc_call_malloc (&fnblock, NULL, size);
gfc_conv_descriptor_data_set (&fnblock, comp, tmp);
- gfc_conv_descriptor_dtype_set (&fnblock, comp,
-gfc_get_dtype (ctype));
if (c->initializer && c->initializer->rank)
{
+ gfc_se tse;
gfc_init_se (&tse, NULL);
- e = gfc_copy_expr (c->initializer);
+ gfc_expr *e = gfc_copy_expr (c->initializer);
gfc_insert_parameter_exprs (e, pdt_param_list
[gcc(refs/users/mikael/heads/refactor_descriptor_v08)] Suppression modif offset trans_associate_var
https://gcc.gnu.org/g:8ce0ef69c547a5319161824f936cfdcf735a6fdd
commit 8ce0ef69c547a5319161824f936cfdcf735a6fdd
Author: Mikael Morin
Date: Mon Feb 17 14:43:06 2025 +0100
Suppression modif offset trans_associate_var
Correction bootstrap suppression variables inutilisées
Diff:
---
gcc/fortran/trans-stmt.cc | 18 --
1 file changed, 18 deletions(-)
diff --git a/gcc/fortran/trans-stmt.cc b/gcc/fortran/trans-stmt.cc
index ddd0a120229c..edfed1d264bc 100644
--- a/gcc/fortran/trans-stmt.cc
+++ b/gcc/fortran/trans-stmt.cc
@@ -1877,9 +1877,6 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block
*block)
bool class_target;
bool unlimited;
tree desc;
- tree offset;
- tree dim;
- int n;
tree charlen;
bool need_len_assign;
bool whole_array = true;
@@ -2299,21 +2296,6 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block
*block)
desc = gfc_class_data_get (se.expr);
- /* Set the offset. */
- offset = gfc_index_zero_node;
- for (n = 0; n < e->rank; n++)
- {
- dim = gfc_rank_cst[n];
- tmp = fold_build2_loc (input_location, MULT_EXPR,
-gfc_array_index_type,
-gfc_conv_descriptor_stride_get (desc, dim),
-gfc_conv_descriptor_lbound_get (desc,
dim));
- offset = fold_build2_loc (input_location, MINUS_EXPR,
- gfc_array_index_type,
- offset, tmp);
- }
- gfc_conv_descriptor_offset_set (&se.pre, desc, offset);
-
if (need_len_assign)
{
if (e->symtree
[gcc(refs/users/mikael/heads/refactor_descriptor_v08)] Suppression set span dans trans_associate_var
https://gcc.gnu.org/g:050cd4d916f682c1a3aefc6e041c861cd16ec2d3
commit 050cd4d916f682c1a3aefc6e041c861cd16ec2d3
Author: Mikael Morin
Date: Mon Feb 17 16:16:47 2025 +0100
Suppression set span dans trans_associate_var
Diff:
---
gcc/fortran/trans-stmt.cc | 10 --
1 file changed, 10 deletions(-)
diff --git a/gcc/fortran/trans-stmt.cc b/gcc/fortran/trans-stmt.cc
index edfed1d264bc..696d24476152 100644
--- a/gcc/fortran/trans-stmt.cc
+++ b/gcc/fortran/trans-stmt.cc
@@ -2177,16 +2177,6 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block
*block)
gfc_conv_shift_descriptor (&se.pre, desc, e->rank);
}
- /* If this is a subreference array pointer associate name use the
-associate variable element size for the value of 'span'. */
- if (sym->attr.subref_array_pointer && !se.direct_byref)
- {
- gcc_assert (e->expr_type == EXPR_VARIABLE);
- tmp = gfc_get_array_span (se.expr, e);
-
- gfc_conv_descriptor_span_set (&se.pre, desc, tmp);
- }
-
if (e->expr_type == EXPR_FUNCTION
&& sym->ts.type == BT_DERIVED
&& sym->ts.u.derived
[gcc r16-2687] c++: consteval blocks
https://gcc.gnu.org/g:d46d8267b5a55e3194e879e691aeee1bc0648bed
commit r16-2687-gd46d8267b5a55e3194e879e691aeee1bc0648bed
Author: Marek Polacek
Date: Mon Jul 14 17:24:18 2025 -0400
c++: consteval blocks
This patch implements consteval blocks, as specified by P2996.
They aren't very useful without define_aggregate, but having
a reviewed implementation on trunk would be great.
consteval {} can be anywhere where a member-declaration or
block-declaration can be. The expression corresponding to it is:
[] -> void static consteval compound-statement ()
and it must be a constant expression.
I've used cp_parser_lambda_expression to take care of most of the
parsing. Since a consteval block can find itself in a template, we
need a vehicle to carry the block for instantiation. Rather than
inventing a new tree, I'm using STATIC_ASSERT.
A consteval block can't return a value but that is checked by virtue
of the lambda having a void return type.
PR c++/120775
gcc/cp/ChangeLog:
* constexpr.cc (cxx_eval_outermost_constant_expr): Use
extract_call_expr.
* cp-tree.h (CONSTEVAL_BLOCK_P, LAMBDA_EXPR_CONSTEVAL_BLOCK_P):
Define.
(finish_static_assert): Adjust declaration.
(current_nonlambda_function): Likewise.
* lambda.cc (current_nonlambda_function): New parameter. Only keep
iterating if the function represents a consteval block.
* parser.cc (cp_parser_lambda_expression): New parameter for
consteval blocks. Use it. Set LAMBDA_EXPR_CONSTEVAL_BLOCK_P.
(cp_parser_lambda_declarator_opt): Likewise.
(build_empty_string): New.
(cp_parser_next_tokens_are_consteval_block_p): New.
(cp_parser_consteval_block): New.
(cp_parser_block_declaration): Handle consteval blocks.
(cp_parser_static_assert): Use build_empty_string.
(cp_parser_member_declaration): Handle consteval blocks.
* pt.cc (tsubst_stmt): Adjust a call to finish_static_assert.
* semantics.cc (finish_fname): Warn for consteval blocks.
(finish_static_assert): New parameter for consteval blocks. Set
CONSTEVAL_BLOCK_P. Evaluate consteval blocks specially.
gcc/testsuite/ChangeLog:
* g++.dg/cpp26/consteval-block1.C: New test.
* g++.dg/cpp26/consteval-block2.C: New test.
* g++.dg/cpp26/consteval-block3.C: New test.
* g++.dg/cpp26/consteval-block4.C: New test.
* g++.dg/cpp26/consteval-block5.C: New test.
* g++.dg/cpp26/consteval-block6.C: New test.
* g++.dg/cpp26/consteval-block7.C: New test.
* g++.dg/cpp26/consteval-block8.C: New test.
Reviewed-by: Jason Merrill
Diff:
---
gcc/cp/constexpr.cc | 7 +-
gcc/cp/cp-tree.h | 14 ++-
gcc/cp/lambda.cc | 12 ++-
gcc/cp/parser.cc | 135 +-
gcc/cp/pt.cc | 3 +-
gcc/cp/semantics.cc | 27 +-
gcc/testsuite/g++.dg/cpp26/consteval-block1.C | 82
gcc/testsuite/g++.dg/cpp26/consteval-block2.C | 49 ++
gcc/testsuite/g++.dg/cpp26/consteval-block3.C | 41
gcc/testsuite/g++.dg/cpp26/consteval-block4.C | 41
gcc/testsuite/g++.dg/cpp26/consteval-block5.C | 70 +
gcc/testsuite/g++.dg/cpp26/consteval-block6.C | 108 +
gcc/testsuite/g++.dg/cpp26/consteval-block7.C | 12 +++
gcc/testsuite/g++.dg/cpp26/consteval-block8.C | 38
14 files changed, 600 insertions(+), 39 deletions(-)
diff --git a/gcc/cp/constexpr.cc b/gcc/cp/constexpr.cc
index f92beb17906e..e051a50fe16e 100644
--- a/gcc/cp/constexpr.cc
+++ b/gcc/cp/constexpr.cc
@@ -10329,11 +10329,14 @@ cxx_eval_outermost_constant_expr (tree t, bool
allow_non_constant,
{
if (cxx_dialect < cxx20)
return t;
- if (TREE_CODE (t) != CALL_EXPR && TREE_CODE (t) != AGGR_INIT_EXPR)
+ /* We could have a COMPOUND_EXPR here coming from
+keep_unused_object_arg. */
+ tree x = extract_call_expr (t);
+ if (x == NULL_TREE || x == error_mark_node)
return t;
/* Calls to immediate functions returning void need to be
evaluated. */
- tree fndecl = cp_get_callee_fndecl_nofold (t);
+ tree fndecl = cp_get_callee_fndecl_nofold (x);
if (fndecl == NULL_TREE || !DECL_IMMEDIATE_FUNCTION_P (fndecl))
return t;
else
diff --git a/gcc/cp/cp-tree.h b/gcc/cp/cp-tree.h
index 0ac3ecbd4c3a..fb8e0d8d98e3 100644
--- a/gcc/cp/cp-tree.h
+++ b/gcc/cp/cp-tree.h
@@ -453,6 +453,8 @@ extern GTY(()) tree cp_global_trees[CPTI_MAX];
[gcc] Deleted branch 'mikael/heads/refactor_descriptor_v08' in namespace 'refs/users'
The branch 'mikael/heads/refactor_descriptor_v08' in namespace 'refs/users' was
deleted.
It previously pointed to:
3f23edec801f... Suppression modification span
Diff:
!!! WARNING: THE FOLLOWING COMMITS ARE NO LONGER ACCESSIBLE (LOST):
---
3f23ede... Suppression modification span
bc40798... Essai suppression initialisation span dans gfc_conv_expr_de
0b6cbdf... Suppression mise à jour upper bound.
4bfc899... Déplacement gfc_grow_array
c41ded7... Déplacemement plus de code gfc_set_pdt_array_descriptor
ab2bc55... Extraction gfc_set_pdt_array_descriptor
9a7375a... Extraction gfc_set_descriptor_for_assign_realloc
d79db50... Suppression mise à jour offset forall
050cd4d... Suppression set span dans trans_associate_var
8ce0ef6... Suppression modif offset trans_associate_var
05877f1... Extraction get_array_memory_size
7678d34... Mise à jour offset & span dans gfc_array_init_size
09730ed... Factorisation descriptor_element_size
e3f99dc... Extraction gfc_shift_descriptor
aaab7ec... Extraction gfc_set_temporary_descriptor
b31ddda... Extraction gfc_copy_descriptor
7b80431... Renseignement token dans gcf_set_descriptor_from_scalar
d5a26d5... Extraction gfc_set_descriptor_from_scalar
c7a0650... Extraction gfc_set_descriptor_from_scalar
4caa6ff... Extraction gfc_set_descriptor_from_scalar
4539ff3... Extraction set_gfc_from_cfi
9cd0407... Extraction gfc_set_gfc_from_cfi
23a9720... Refactoring gfc_conv_descriptor_sm_get
c934351... Extraction gfc_conv_shift_subarray_descriptor
0d9698e... Factorisation set descriptor with shape
49b2920... Factorisation gfc_set_contiguous_descriptor
8011a42... Factorisation gfc_conv_shift_descriptor
f6e4787... Extraction gfc_set_descriptor
5c8e7f7... Extraction gfc_copy_descriptor
c820a45... Extraction gfc_conv_shift_descriptor
b8fb22c... Extraction gfc_conv_remap_descriptor
75c19aa... Déplacement gfc_descriptor_size
d13faea... Extraction gfc_copy_sequence_descriptor
6595659... Extraction fonction gfc_nullify_descriptor
cd16c97... Appel méthode shift descriptor dans gfc_trans_pointer_assi
7053611... Déplacement shift descriptor vers gfc_conv_array_parameter
78e0108... Suppression set_dtype_for_unallocated
e435054... Creation gfc_conv_null_array_descriptor, gfc_conv_scalar_nu
a122925... Extraction gfc_init_absent_descriptor
eb116d2... Extraction gfc_init_static_descriptor
e4bb3f6... Extraction gfc_build_default_class_descriptor
08c7492... Suppression initialisation span pour les pointeurs
4366c65... Introduction gfc_init_descriptor_result
b2c1ff9... Modif gfc_init_descriptor_variable
c0b5be0... Introduction gfc_symbol_attr
3739fbf... Extraction gfc_init_descriptor_variable
d040acb... Ajout locations setters
97dc5af... Refactoring getters & setters
9fc3699... Interdiction non-lvalue as lhs
ee83a10... Ajout non_lvalue getters.
79f926a... Utilisation gfc_conv_descriptor_token_set
ac17606... Suppression gfc_conv_descriptor_dimension compil' OK
3e82be4... Suppression gfc_conv_descriptor_attribute compil' OK
c60fef7... Suppression gfc_conv_descriptor_type compil' OK
9ea5341... Suppression gfc_conv_descriptor_rank compil' OK
191f175... Suppression gfc_conv_descriptor_version compil' OK
2a47875... Suppression gfc_conv_descriptor_elem_len compil' OK
7226384... Suppression gfc_conv_descriptor_dtype compil' OK
91586e2... Utilisation gfc_conv_descriptor_offset_{g,s}et
9285b2d... Suppression gfc_conv_descriptor_data_addr
658b609... Utilisation gfc_conv_descriptor_data_set
93319de... Déplacement fonctions descripteur vers fichier séparé
e859603... fortran: Factor array descriptor references
a763ce8... fortran: Evaluate class function bounds in the scalarizer
5fca6b2... fortran: Ajout test
0e7ccf5... gimple-simulate: prise en charge BUILTIN_REALLOC
f46a49b... gimple-simulate: Affichage des arguments à l'appel de fonc
c52dbb2... gimple-simulate: Prise en charge VIEW_CONVERT_EXPR
148dd2a... gimple-simulate: Prise en charge REALPART/IMAGPART
b70e45a... Sauvegarde/restoration cfun
3d6167d... Prise en charge affichage TARGET_MEM_REF
9701f5d... gimple-simulate: Add a gimple IR interpreter/simulator
[gcc(refs/users/mikael/heads/refactor_descriptor_v08)] Sauvegarde/restoration cfun
https://gcc.gnu.org/g:b70e45aba938755bd19442c35003b322cd625c25 commit b70e45aba938755bd19442c35003b322cd625c25 Author: Mikael Morin Date: Tue Jul 8 13:13:25 2025 +0200 Sauvegarde/restoration cfun Correction bootstrap Correction bootstrap Correction bootstrap Diff: --- gcc/gimple-simulate.cc | 8 1 file changed, 8 insertions(+) diff --git a/gcc/gimple-simulate.cc b/gcc/gimple-simulate.cc index a85e6f63cc92..09491076e95d 100644 --- a/gcc/gimple-simulate.cc +++ b/gcc/gimple-simulate.cc @@ -4720,7 +4720,9 @@ simul_scope_evaluate_tests () DECL_CONTEXT (result) = func; DECL_RESULT (func) = result; + push_cfun (nullptr); init_lowered_empty_function (func, true, profile_count::one ()); + pop_cfun (); tree def_var = create_var (integer_type_node, "def_var"); DECL_CONTEXT (def_var) = func; @@ -6482,8 +6484,10 @@ simul_scope_simulate_call_tests () DECL_CONTEXT (result) = my_int_func; DECL_RESULT (my_int_func) = result; + push_cfun (nullptr); basic_block bb = init_lowered_empty_function (my_int_func, true, profile_count::one ()); + pop_cfun (); gimple_stmt_iterator gsi = gsi_last_bb (bb); greturn *ret_stmt = gimple_build_return (cst6); gsi_insert_after (&gsi, ret_stmt, GSI_CONTINUE_LINKING); @@ -6534,8 +6538,10 @@ simul_scope_simulate_call_tests () DECL_ARGUMENTS (int_func_with_arg) = arg; layout_decl (arg, 0); + push_cfun (nullptr); basic_block bb2 = init_lowered_empty_function (int_func_with_arg, true, profile_count::one ()); + pop_cfun (); gimple_stmt_iterator gsi2 = gsi_last_bb (bb2); greturn *ret_stmt2 = gimple_build_return (arg); gsi_insert_after (&gsi2, ret_stmt2, GSI_CONTINUE_LINKING); @@ -6618,7 +6624,9 @@ simul_scope_simulate_call_tests () DECL_CONTEXT (void_result) = simple_func; DECL_RESULT (simple_func) = void_result; + push_cfun (nullptr); init_lowered_empty_function (simple_func, true, profile_count::one ()); + pop_cfun (); gcall * simple_call = gimple_build_call (simple_func, 0);
[gcc(refs/users/mikael/heads/refactor_descriptor_v08)] gimple-simulate: Prise en charge REALPART/IMAGPART
https://gcc.gnu.org/g:148dd2aea79e46038ff374f03b088eca0c84e090
commit 148dd2aea79e46038ff374f03b088eca0c84e090
Author: Mikael Morin
Date: Thu Jul 24 12:34:22 2025 +0200
gimple-simulate: Prise en charge REALPART/IMAGPART
Diff:
---
gcc/gimple-simulate.cc | 99 ++
1 file changed, 99 insertions(+)
diff --git a/gcc/gimple-simulate.cc b/gcc/gimple-simulate.cc
index 09491076e95d..910e75ace858 100644
--- a/gcc/gimple-simulate.cc
+++ b/gcc/gimple-simulate.cc
@@ -2275,6 +2275,20 @@ simul_scope::decompose_ref (tree data_ref, data_storage
* & storage,
}
break;
+ case IMAGPART_EXPR:
+ {
+ unsigned size = get_constant_type_size (TREE_TYPE (data_ref));
+ /* Size is the size of the imaginary part, so we can conclude
+ it is also the size of the real part, and the offset of the
+ imaginary part. */
+ add_offset = wi::shwi (size, HOST_BITS_PER_WIDE_INT);
+ }
+ /* Fall through. */
+
+ case REALPART_EXPR:
+ parent_data_ref = TREE_OPERAND (data_ref, 0);
+ break;
+
default:
gcc_unreachable ();
}
@@ -6331,8 +6345,93 @@ simul_scope_simulate_assign_tests ()
wide_int wi10 = val10_after.get_known ();
ASSERT_PRED1 (wi::fits_shwi_p, wi10);
ASSERT_EQ (wi10.to_shwi (), 23);
+
+
+ tree cplx_type_11 = build_complex_type (float_type_node);
+ tree c11 = create_var (cplx_type_11, "c11");
+
+ vec decls11 {};
+ decls11.safe_push (c11);
+
+ context_builder builder11;
+ builder11.add_decls (&decls11);
+ simul_scope ctx11 = builder11.build (mem, printer);
+
+ data_storage *strg_c11 = ctx11.find_reachable_var (c11);
+ gcc_assert (strg_c11 != nullptr);
+
+ data_value c11_before = strg_c11->get_value ();
+ ASSERT_EQ (c11_before.classify (), VAL_UNDEFINED);
+
+ unsigned float_size = get_constant_type_size (float_type_node);
+ tree float_sized_int = build_nonstandard_integer_type (float_size, 0);
+ tree val44_11 = fold_convert (float_type_node,
+ build_int_cst (float_sized_int, 44));
+ ASSERT_EQ (TREE_CODE (val44_11), REAL_CST);
+
+ tree real11 = build1 (REALPART_EXPR, float_type_node, c11);
+ gimple *g11 = gimple_build_assign (real11, val44_11);
+ ctx11.simulate (g11);
+
+ data_value c11_after = strg_c11->get_value ();
+ ASSERT_EQ (c11_after.classify (), VAL_MIXED);
+ ASSERT_EQ (c11_after.get_bitwidth (), 2 * float_size);
+ ASSERT_EQ (c11_after.classify (0, float_size),
+VAL_KNOWN);
+ ASSERT_EQ (c11_after.classify (float_size, float_size),
+VAL_UNDEFINED);
+ wide_int wi11 = c11_after.get_known_at (0, float_size);
+ ASSERT_PRED1 (wi::fits_shwi_p, wi11);
+ tree wi11_int = build_int_cst (float_sized_int, wi11.to_shwi ());
+ tree wi11_real = fold_build1 (VIEW_CONVERT_EXPR, float_type_node,
+ wi11_int);
+ ASSERT_EQ (TREE_CODE (wi11_real), REAL_CST);
+ ASSERT_TRUE (real_equal (TREE_REAL_CST_PTR (wi11_real),
+ TREE_REAL_CST_PTR (val44_11)));
+
+
+ tree cplx_type_12 = build_complex_type (float_type_node);
+ tree c12 = create_var (cplx_type_12, "c12");
+
+ vec decls12 {};
+ decls12.safe_push (c12);
+
+ context_builder builder12;
+ builder12.add_decls (&decls12);
+ simul_scope ctx12 = builder12.build (mem, printer);
+
+ data_storage *strg_c12 = ctx12.find_reachable_var (c12);
+ gcc_assert (strg_c12 != nullptr);
+
+ data_value c12_before = strg_c12->get_value ();
+ ASSERT_EQ (c12_before.classify (), VAL_UNDEFINED);
+
+ tree val33_12 = fold_convert (float_type_node,
+ build_int_cst (float_sized_int, 33));
+ ASSERT_EQ (TREE_CODE (val33_12), REAL_CST);
+
+ tree real12 = build1 (IMAGPART_EXPR, float_type_node, c12);
+ gimple *g12 = gimple_build_assign (real12, val33_12);
+ ctx12.simulate (g12);
+
+ data_value c12_after = strg_c12->get_value ();
+ ASSERT_EQ (c12_after.classify (), VAL_MIXED);
+ ASSERT_EQ (c12_after.get_bitwidth (), 2 * float_size);
+ ASSERT_EQ (c12_after.classify (0, float_size),
+VAL_UNDEFINED);
+ ASSERT_EQ (c12_after.classify (float_size, float_size),
+VAL_KNOWN);
+ wide_int wi12 = c12_after.get_known_at (float_size, float_size);
+ ASSERT_PRED1 (wi::fits_shwi_p, wi12);
+ tree wi12_int = build_int_cst (float_sized_int, wi12.to_shwi ());
+ tree wi12_real = fold_build1 (VIEW_CONVERT_EXPR, float_type_node,
+ wi12_int);
+ ASSERT_EQ (TREE_CODE (wi12_real), REAL_CST);
+ ASSERT_TRUE (real_equal (TREE_REAL_CST_PTR (wi12_real),
+ TREE_REAL_CST_PTR (val33_12)));
}
+
void
simul_scope_print_call_tests ()
{
