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
This commit is contained in:
Jakub Jelinek 2019-05-16 11:37:43 +02:00 committed by Jakub Jelinek
parent 86c23d9314
commit 4b8e35f1b1
8 changed files with 62 additions and 4 deletions

View File

@ -1,5 +1,18 @@
2019-05-16 Jakub Jelinek <jakub@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.
* lto-streamer.h (LTO_major_version): Bump to 9.
2019-05-16 Jun Ma <JunMa@linux.alibaba.com>

View File

@ -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)

View File

@ -1,3 +1,10 @@
2019-05-16 Jakub Jelinek <jakub@redhat.com>
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 <jb@gcc.gnu.org>
* parse.c (gfc_parse_file): Remove translation string markers.

View File

@ -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)

View File

@ -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. */

View File

@ -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))

View File

@ -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))

View File

@ -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)