From 4b8e35f1b1df60633aeb0bf37ea9f6311f2132b9 Mon Sep 17 00:00:00 2001 From: Jakub Jelinek Date: Thu, 16 May 2019 11:37:43 +0200 Subject: [PATCH] re PR fortran/90329 (Incompatibility between gfortran and C lapack calls) PR fortran/90329 * tree-core.h (struct tree_decl_common): Document decl_nonshareable_flag for PARM_DECLs. * tree.h (DECL_HIDDEN_STRING_LENGTH): Define. * calls.c (expand_call): Don't try tail call if caller has any DECL_HIDDEN_STRING_LENGTH PARM_DECLs that are or might be passed on the stack and callee needs to pass any arguments on the stack. * tree-streamer-in.c (unpack_ts_decl_common_value_fields): Use else if instead of series of mutually exclusive ifs. Handle DECL_HIDDEN_STRING_LENGTH for PARM_DECLs. * tree-streamer-out.c (pack_ts_decl_common_value_fields): Likewise. * trans-decl.c (create_function_arglist): Set DECL_HIDDEN_STRING_LENGTH on hidden string length PARM_DECLs if len is constant. From-SVN: r271285 --- gcc/ChangeLog | 13 +++++++++++++ gcc/calls.c | 22 ++++++++++++++++++++++ gcc/fortran/ChangeLog | 7 +++++++ gcc/fortran/trans-decl.c | 4 ++++ gcc/tree-core.h | 1 + gcc/tree-streamer-in.c | 7 +++++-- gcc/tree-streamer-out.c | 7 +++++-- gcc/tree.h | 5 +++++ 8 files changed, 62 insertions(+), 4 deletions(-) diff --git a/gcc/ChangeLog b/gcc/ChangeLog index 84c0d38737d..3f73f321fbe 100644 --- a/gcc/ChangeLog +++ b/gcc/ChangeLog @@ -1,5 +1,18 @@ 2019-05-16 Jakub Jelinek + PR fortran/90329 + * tree-core.h (struct tree_decl_common): Document + decl_nonshareable_flag for PARM_DECLs. + * tree.h (DECL_HIDDEN_STRING_LENGTH): Define. + * calls.c (expand_call): Don't try tail call if caller + has any DECL_HIDDEN_STRING_LENGTH PARM_DECLs that are or might be + passed on the stack and callee needs to pass any arguments on the + stack. + * tree-streamer-in.c (unpack_ts_decl_common_value_fields): Use + else if instead of series of mutually exclusive ifs. Handle + DECL_HIDDEN_STRING_LENGTH for PARM_DECLs. + * tree-streamer-out.c (pack_ts_decl_common_value_fields): Likewise. + * lto-streamer.h (LTO_major_version): Bump to 9. 2019-05-16 Jun Ma diff --git a/gcc/calls.c b/gcc/calls.c index 6b22e7a2315..c8a42680041 100644 --- a/gcc/calls.c +++ b/gcc/calls.c @@ -3628,6 +3628,28 @@ expand_call (tree exp, rtx target, int ignore) || dbg_cnt (tail_call) == false) try_tail_call = 0; + /* Workaround buggy C/C++ wrappers around Fortran routines with + character(len=constant) arguments if the hidden string length arguments + are passed on the stack; if the callers forget to pass those arguments, + attempting to tail call in such routines leads to stack corruption. + Avoid tail calls in functions where at least one such hidden string + length argument is passed (partially or fully) on the stack in the + caller and the callee needs to pass any arguments on the stack. + See PR90329. */ + if (try_tail_call && maybe_ne (args_size.constant, 0)) + for (tree arg = DECL_ARGUMENTS (current_function_decl); + arg; arg = DECL_CHAIN (arg)) + if (DECL_HIDDEN_STRING_LENGTH (arg) && DECL_INCOMING_RTL (arg)) + { + subrtx_iterator::array_type array; + FOR_EACH_SUBRTX (iter, array, DECL_INCOMING_RTL (arg), NONCONST) + if (MEM_P (*iter)) + { + try_tail_call = 0; + break; + } + } + /* If the user has marked the function as requiring tail-call optimization, attempt it. */ if (must_tail_call) diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index b836610d820..057afe66ce7 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,10 @@ +2019-05-16 Jakub Jelinek + + PR fortran/90329 + * trans-decl.c (create_function_arglist): Set + DECL_HIDDEN_STRING_LENGTH on hidden string length PARM_DECLs if + len is constant. + 2019-05-15 Janne Blomqvist * parse.c (gfc_parse_file): Remove translation string markers. diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index c010956a7ef..07d1c33af72 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -2512,6 +2512,10 @@ create_function_arglist (gfc_symbol * sym) DECL_ARG_TYPE (length) = len_type; TREE_READONLY (length) = 1; gfc_finish_decl (length); + if (f->sym->ts.u.cl + && f->sym->ts.u.cl->length + && f->sym->ts.u.cl->length->expr_type == EXPR_CONSTANT) + DECL_HIDDEN_STRING_LENGTH (length) = 1; /* Remember the passed value. */ if (!f->sym->ts.u.cl || f->sym->ts.u.cl->passed_length) diff --git a/gcc/tree-core.h b/gcc/tree-core.h index 552196b1b42..fbed0c379b2 100644 --- a/gcc/tree-core.h +++ b/gcc/tree-core.h @@ -1683,6 +1683,7 @@ struct GTY(()) tree_decl_common { /* In a VAR_DECL and PARM_DECL, this is DECL_READ_P. */ unsigned decl_read_flag : 1; /* In a VAR_DECL or RESULT_DECL, this is DECL_NONSHAREABLE. */ + /* In a PARM_DECL, this is DECL_HIDDEN_STRING_LENGTH. */ unsigned decl_nonshareable_flag : 1; /* DECL_OFFSET_ALIGN, used only for FIELD_DECLs. */ diff --git a/gcc/tree-streamer-in.c b/gcc/tree-streamer-in.c index 0084e478934..f6d137316ac 100644 --- a/gcc/tree-streamer-in.c +++ b/gcc/tree-streamer-in.c @@ -251,7 +251,7 @@ unpack_ts_decl_common_value_fields (struct bitpack_d *bp, tree expr) LABEL_DECL_UID (expr) = -1; } - if (TREE_CODE (expr) == FIELD_DECL) + else if (TREE_CODE (expr) == FIELD_DECL) { DECL_PACKED (expr) = (unsigned) bp_unpack_value (bp, 1); DECL_NONADDRESSABLE_P (expr) = (unsigned) bp_unpack_value (bp, 1); @@ -259,12 +259,15 @@ unpack_ts_decl_common_value_fields (struct bitpack_d *bp, tree expr) expr->decl_common.off_align = bp_unpack_value (bp, 8); } - if (VAR_P (expr)) + else if (VAR_P (expr)) { DECL_HAS_DEBUG_EXPR_P (expr) = (unsigned) bp_unpack_value (bp, 1); DECL_NONLOCAL_FRAME (expr) = (unsigned) bp_unpack_value (bp, 1); } + else if (TREE_CODE (expr) == PARM_DECL) + DECL_HIDDEN_STRING_LENGTH (expr) = (unsigned) bp_unpack_value (bp, 1); + if (TREE_CODE (expr) == RESULT_DECL || TREE_CODE (expr) == PARM_DECL || VAR_P (expr)) diff --git a/gcc/tree-streamer-out.c b/gcc/tree-streamer-out.c index b66426387d6..3f619e830a7 100644 --- a/gcc/tree-streamer-out.c +++ b/gcc/tree-streamer-out.c @@ -212,7 +212,7 @@ pack_ts_decl_common_value_fields (struct bitpack_d *bp, tree expr) bp_pack_var_len_unsigned (bp, EH_LANDING_PAD_NR (expr)); } - if (TREE_CODE (expr) == FIELD_DECL) + else if (TREE_CODE (expr) == FIELD_DECL) { bp_pack_value (bp, DECL_PACKED (expr), 1); bp_pack_value (bp, DECL_NONADDRESSABLE_P (expr), 1); @@ -220,12 +220,15 @@ pack_ts_decl_common_value_fields (struct bitpack_d *bp, tree expr) bp_pack_value (bp, expr->decl_common.off_align, 8); } - if (VAR_P (expr)) + else if (VAR_P (expr)) { bp_pack_value (bp, DECL_HAS_DEBUG_EXPR_P (expr), 1); bp_pack_value (bp, DECL_NONLOCAL_FRAME (expr), 1); } + else if (TREE_CODE (expr) == PARM_DECL) + bp_pack_value (bp, DECL_HIDDEN_STRING_LENGTH (expr), 1); + if (TREE_CODE (expr) == RESULT_DECL || TREE_CODE (expr) == PARM_DECL || VAR_P (expr)) diff --git a/gcc/tree.h b/gcc/tree.h index d65affea2ee..3a1e6767cee 100644 --- a/gcc/tree.h +++ b/gcc/tree.h @@ -904,6 +904,11 @@ extern void omp_clause_range_check_failed (const_tree, const char *, int, (TREE_CHECK2 (NODE, VAR_DECL, \ RESULT_DECL)->decl_common.decl_nonshareable_flag) +/* In a PARM_DECL, set for Fortran hidden string length arguments that some + buggy callers don't pass to the callee. */ +#define DECL_HIDDEN_STRING_LENGTH(NODE) \ + (TREE_CHECK (NODE, PARM_DECL)->decl_common.decl_nonshareable_flag) + /* In a CALL_EXPR, means that the call is the jump from a thunk to the thunked-to function. */ #define CALL_FROM_THUNK_P(NODE) (CALL_EXPR_CHECK (NODE)->base.protected_flag) -- 2.30.2