Hi! Fortran subroutines/functions that have CHARACTER arguments have also hidden arguments at the end of the argument list which hold the string length. This is something all Fortran compilers I've tried do and is done in order to support calling unprototyped subroutines/functions where one can't know if the callee is using character(len=constant) or character(len=*) argument, where for the latter one has to pass the extra argument because there is no other way to propagate that info, while for the former it is kind of redundant but still part of the ABI; the compiler just uses the constant directly instead of asking about the real passed string length.
Another thing is that until PR87689 has been fixed, the Fortran FE has been broken, used vararg-ish prototypes in most cases and that prevented (all?) tail call optimizations in the Fortran code. Apparently it is a common case that buggy C/C++ wrappers around the Fortran functions just ignore the ABI and don't pass the hidden string length arguments at all, which seemed to work fine in gfortran until recently (because the arguments weren't used). When we started making tail calls from such functions, this has of course changed, because when making a tail call we overwrite the caller's argument slots with the arguments we want to pass to the callee. Not really sure why it seemed to work with other compilers; trying https://fortran.godbolt.org/z/ckMt1t subroutine foo (a, b, c, d, e, f, g, h) integer :: b, c, d, e, f, g, h character(len=1) :: a call bar (a, b, c, d, e, f, g, h) end subroutine foo both older/new gfortran and ifort 19.0.0 emit a tail call which overwrites the hidden string length argument with 1, but when trying the https://fortran.godbolt.org/z/xpsH8e LAPACK routine, ifort for some reason doesn't tail call it. I'm not really happy to provide workarounds for undefined behavior, especially because that will mean it might take longer if ever if those buggy programs are fixed. On the other side, the PR87689 bug fix has been backported to all release branches and so now not only trunk, but also 9.1, 8.3.1 and 7.4.1 are affected. Instead of trying to disable all tail calls, this patch disables tail calls from functions/subroutines that have those hidden string length arguments and don't use character(len=*) (in that case the function wouldn't seem to work previously either, because the argument is really used), where those hidden string length arguments are passed on the stack and where the tail callee also would want to pass arguments on the stack (if we spent even more time on this, we could narrow it down further and check if the tail call would actually store anything overlapping the hidden string length arguments on the stack). This workaround probably needs guarding with some Fortran FE specific option, so that it can be disabled, will defer that to the Fortran maintainers. Bootstrapped/regtested on x86_64-linux and i686-linux, ok for trunk and release branches (not sure about LTO on the release branches, does one need to bump anything when changing the LTO format by streaming another bit)? 2019-05-16 Jakub Jelinek <ja...@redhat.com> 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. --- gcc/tree-core.h.jj 2019-02-22 15:22:20.882919620 +0100 +++ gcc/tree-core.h 2019-05-15 08:00:39.284668438 +0200 @@ -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. */ --- gcc/tree.h.jj 2019-05-02 12:18:33.829078755 +0200 +++ gcc/tree.h 2019-05-15 08:06:11.559171046 +0200 @@ -904,6 +904,11 @@ extern void omp_clause_range_check_faile (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) --- gcc/calls.c.jj 2019-04-08 10:11:30.852182466 +0200 +++ gcc/calls.c 2019-05-15 09:03:56.863754839 +0200 @@ -3628,6 +3628,28 @@ expand_call (tree exp, rtx target, int i || 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) --- gcc/tree-streamer-in.c.jj 2019-01-01 12:37:21.184908879 +0100 +++ gcc/tree-streamer-in.c 2019-05-15 08:58:02.123629519 +0200 @@ -251,7 +251,7 @@ unpack_ts_decl_common_value_fields (stru 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 (stru 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)) --- gcc/tree-streamer-out.c.jj 2019-01-24 19:54:20.792500923 +0100 +++ gcc/tree-streamer-out.c 2019-05-15 09:01:23.957287106 +0200 @@ -212,7 +212,7 @@ pack_ts_decl_common_value_fields (struct 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 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)) --- gcc/fortran/trans-decl.c.jj 2019-05-15 08:18:16.000000000 +0200 +++ gcc/fortran/trans-decl.c 2019-05-15 08:31:07.260388229 +0200 @@ -2512,6 +2512,10 @@ create_function_arglist (gfc_symbol * sy 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) Jakub
