This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[Patch, fortran] PR25746 - operator assignment dependency checking
- From: Paul Thomas <paulthomas2 at wanadoo dot fr>
- To: patch <gcc-patches at gcc dot gnu dot org>, "'fortran at gcc dot gnu dot org'" <fortran at gcc dot gnu dot org>
- Cc: Dominique Dhumieres <dominiq at lps dot ens dot fr>, Brooks Moses <bmoses at stanford dot edu>
- Date: Mon, 08 May 2006 17:08:44 +0200
- Subject: [Patch, fortran] PR25746 - operator assignment dependency checking
:ADDPATCH fortran:
This is a revamp of the patch that generated a fair exchange on the
list because the test case had bad code in it and the patch was too
interventionist. This new patch only treats operator assignments.
The patch fixes PR25746 by adding dependency checking to the
translation of elemental subroutine calls if signalled to do so by a
boolian argument to gfc_trans_call. This is done for the two cases
that call elemental subroutines to represent assignments.
The checking is accomplished by calling a new function
gfc_conv_elemental_dependencies before starting the scalarizing body and
calling the elemental subroutine itself. This has the advantage that the
loopinfo and the ss's for each actual argument are available and the
information that they contain is used as much as possible.
The new function proceeds as follows:
It loops over the actual arguments and, if the INTENT is OUT it checks
for dependency with each of the arguments that are not INTENT(OUT).
I have modified dependency.c(gfc_check_fncall_dependency) to prevent
the argument expression from being checked against itself.
If there is a dependency, a temporary loopinfo is made, ready for the
call to gfc_trans_create_temp_array. This is done to prevent this
function from resetting the loop and thereby necessitating the
renormalisation of the ss->data.info's for each of the arguments. Once
the temporary is obtained, the descriptor is obtained afresh, so that
the result can be correctly unpacked after the subroutine call.
Following this, the scalarizer is satisfied by adding the offset for the
temporary to the ss->data.info, using the loop index ranges. Finally,
the result is copied to the destination array and the temporary freed.
As well as testing the fix for the original PR, the testcase checks
various kinds of assignment, including >1D arrays.
Regtested on FC5/Athlon. OK for trunk and 4.1?
Paul
2006-05-08 Paul Thomas <pault@gcc.gnu.org>
PR fortran/25746
* interface.c (gfc_extend_assign): Use new code EXEC_ASSIGN_CALL.
* gfortran.h : Put EXEC_ASSIGN_CALL in enum.
* trans-stmt.c (gfc_conv_elemental_dependencies): New function.
(gfc_trans_call): Call it. Add new boolian argument to flag
need for dependency checking. Assert intent OUT and IN for arg1
and arg2.
(gfc_trans_forall_1): Use new code EXEC_ASSIGN_CALL.
trans-stmt.h : Modify prototype of gfc_trans_call.
trans.c (gfc_trans_code): Add call for EXEC_ASSIGN_CALL.
st.c (gfc_free_statement): Free actual for EXEC_ASSIGN_CALL.
* dependency.c (gfc_check_fncall_dependency): Don't check other
against itself.
2006-05-08 Paul Thomas <pault@gcc.gnu.org>
PR fortran/25746
* gfortran.dg/elemental_subroutine_3.f90: New test.
Index: gcc/fortran/interface.c
===================================================================
*** gcc/fortran/interface.c (revision 113593)
--- gcc/fortran/interface.c (working copy)
*************** gfc_extend_assign (gfc_code * c, gfc_nam
*** 1827,1833 ****
}
/* Replace the assignment with the call. */
! c->op = EXEC_CALL;
c->symtree = find_sym_in_symtree (sym);
c->expr = NULL;
c->expr2 = NULL;
--- 1827,1833 ----
}
/* Replace the assignment with the call. */
! c->op = EXEC_ASSIGN_CALL;
c->symtree = find_sym_in_symtree (sym);
c->expr = NULL;
c->expr2 = NULL;
Index: gcc/fortran/gfortran.h
===================================================================
*** gcc/fortran/gfortran.h (revision 113593)
--- gcc/fortran/gfortran.h (working copy)
*************** gfc_forall_iterator;
*** 1487,1493 ****
typedef enum
{
EXEC_NOP = 1, EXEC_ASSIGN, EXEC_LABEL_ASSIGN, EXEC_POINTER_ASSIGN,
! EXEC_GOTO, EXEC_CALL, EXEC_RETURN, EXEC_ENTRY,
EXEC_PAUSE, EXEC_STOP, EXEC_CONTINUE,
EXEC_IF, EXEC_ARITHMETIC_IF, EXEC_DO, EXEC_DO_WHILE, EXEC_SELECT,
EXEC_FORALL, EXEC_WHERE, EXEC_CYCLE, EXEC_EXIT,
--- 1487,1493 ----
typedef enum
{
EXEC_NOP = 1, EXEC_ASSIGN, EXEC_LABEL_ASSIGN, EXEC_POINTER_ASSIGN,
! EXEC_GOTO, EXEC_CALL, EXEC_ASSIGN_CALL, EXEC_RETURN, EXEC_ENTRY,
EXEC_PAUSE, EXEC_STOP, EXEC_CONTINUE,
EXEC_IF, EXEC_ARITHMETIC_IF, EXEC_DO, EXEC_DO_WHILE, EXEC_SELECT,
EXEC_FORALL, EXEC_WHERE, EXEC_CYCLE, EXEC_EXIT,
Index: gcc/fortran/trans-stmt.c
===================================================================
*** gcc/fortran/trans-stmt.c (revision 113593)
--- gcc/fortran/trans-stmt.c (working copy)
*************** gfc_trans_entry (gfc_code * code)
*** 199,208 ****
}
/* Translate the CALL statement. Builds a call to an F95 subroutine. */
tree
! gfc_trans_call (gfc_code * code)
{
gfc_se se;
gfc_ss * ss;
--- 199,319 ----
}
+ /* Check for dependencies between INTENT(IN) and INTENT(OUT) arguments of
+ elemental subroutines. Make temporaries for output arguments if any such
+ dependencies are found. Output arguments are chosen because internal_unpack
+ can be used, as is, to copy the result back to the variable. */
+ static void
+ gfc_conv_elemental_dependencies (gfc_se * se, gfc_se * loopse,
+ gfc_symbol * sym, gfc_actual_arglist * arg)
+ {
+ gfc_actual_arglist *arg0;
+ gfc_expr *e;
+ gfc_formal_arglist *formal;
+ gfc_loopinfo tmp_loop;
+ gfc_se parmse;
+ gfc_ss *ss;
+ gfc_ss_info *info;
+ gfc_symbol *fsym;
+ int n;
+ stmtblock_t block;
+ tree data;
+ tree offset;
+ tree size;
+ tree tmp;
+
+ if (loopse->ss == NULL)
+ return;
+
+ ss = loopse->ss;
+ arg0 = arg;
+ formal = sym->formal;
+
+ /* Loop over all the arguments testing for dependencies. */
+ for (; arg != NULL; arg = arg->next, formal = formal ? formal->next : NULL)
+ {
+ e = arg->expr;
+ if (e == NULL)
+ continue;
+
+ /* Obtain the info structure for the current argument. */
+ info = NULL;
+ for (ss = loopse->ss; ss && ss != gfc_ss_terminator; ss = ss->next)
+ {
+ if (ss->expr != e)
+ continue;
+ info = &ss->data.info;
+ break;
+ }
+
+ /* If there is a dependency, create a temporary and use it
+ instead of the variable. */
+ fsym = formal ? formal->sym : NULL;
+ if (e->expr_type == EXPR_VARIABLE
+ && e->rank && fsym
+ && fsym->attr.intent == INTENT_OUT
+ && gfc_check_fncall_dependency (e, INTENT_OUT, sym, arg0))
+ {
+ /* Make a local loopinfo for the temporary creation, so that
+ none of the other ss->info's have to be renormalized. */
+ gfc_init_loopinfo (&tmp_loop);
+ for (n = 0; n < info->dimen; n++)
+ {
+ tmp_loop.to[n] = loopse->loop->to[n];
+ tmp_loop.from[n] = loopse->loop->from[n];
+ tmp_loop.order[n] = loopse->loop->order[n];
+ }
+
+ /* Generate the temporary. Merge the block so that the
+ declarations are put at the right binding level. */
+ size = gfc_create_var (gfc_array_index_type, NULL);
+ data = gfc_create_var (pvoid_type_node, NULL);
+ gfc_start_block (&block);
+ tmp = gfc_typenode_for_spec (&e->ts);
+ tmp = gfc_trans_create_temp_array (&se->pre, &se->post,
+ &tmp_loop, info, tmp,
+ false, true, false);
+ gfc_add_modify_expr (&se->pre, size, tmp);
+ tmp = fold_convert (pvoid_type_node, info->data);
+ gfc_add_modify_expr (&se->pre, data, tmp);
+ gfc_merge_block_scope (&block);
+
+ /* Obtain the argument descriptor for unpacking. */
+ gfc_init_se (&parmse, NULL);
+ parmse.want_pointer = 1;
+ gfc_conv_expr_descriptor (&parmse, e, gfc_walk_expr (e));
+ gfc_add_block_to_block (&se->pre, &parmse.pre);
+
+ /* Calculate the offset for the temporary. */
+ offset = gfc_index_zero_node;
+ for (n = 0; n < info->dimen; n++)
+ {
+ tmp = gfc_conv_descriptor_stride (info->descriptor,
+ gfc_rank_cst[n]);
+ tmp = fold_build2 (MULT_EXPR, gfc_array_index_type,
+ loopse->loop->from[n], tmp);
+ offset = fold_build2 (MINUS_EXPR, gfc_array_index_type,
+ offset, tmp);
+ }
+ info->offset = gfc_create_var (gfc_array_index_type, NULL);
+ gfc_add_modify_expr (&se->pre, info->offset, offset);
+
+ /* Copy the result back using unpack. */
+ tmp = gfc_chainon_list (NULL_TREE, parmse.expr);
+ tmp = gfc_chainon_list (tmp, data);
+ tmp = build_function_call_expr (gfor_fndecl_in_unpack, tmp);
+ gfc_add_expr_to_block (&se->post, tmp);
+
+ gfc_add_block_to_block (&se->post, &parmse.post);
+ }
+ }
+ }
+
+
/* Translate the CALL statement. Builds a call to an F95 subroutine. */
tree
! gfc_trans_call (gfc_code * code, bool dependency_check)
{
gfc_se se;
gfc_ss * ss;
*************** gfc_trans_call (gfc_code * code)
*** 269,279 ****
gfc_conv_loop_setup (&loop);
gfc_mark_ss_chain_used (ss, 1);
/* Generate the loop body. */
gfc_start_scalarized_body (&loop, &body);
gfc_init_block (&block);
- gfc_copy_loopinfo_to_se (&loopse, &loop);
- loopse.ss = ss;
/* Add the subroutine call to the block. */
gfc_conv_function_call (&loopse, code->resolved_sym, code->ext.actual);
--- 380,404 ----
gfc_conv_loop_setup (&loop);
gfc_mark_ss_chain_used (ss, 1);
+ /* Convert the arguments, checking for dependencies. */
+ gfc_copy_loopinfo_to_se (&loopse, &loop);
+ loopse.ss = ss;
+
+ /* For operator assignment, we need to do dependency checking.
+ We also check the intent of the parameters. */
+ if (dependency_check)
+ {
+ gfc_symbol *sym;
+ sym = code->resolved_sym;
+ gcc_assert (sym->formal->sym->attr.intent = INTENT_OUT);
+ gcc_assert (sym->formal->next->sym->attr.intent = INTENT_IN);
+ gfc_conv_elemental_dependencies (&se, &loopse, sym,
+ code->ext.actual);
+ }
+
/* Generate the loop body. */
gfc_start_scalarized_body (&loop, &body);
gfc_init_block (&block);
/* Add the subroutine call to the block. */
gfc_conv_function_call (&loopse, code->resolved_sym, code->ext.actual);
*************** gfc_trans_call (gfc_code * code)
*** 287,292 ****
--- 412,418 ----
gfc_trans_scalarizing_loops (&loop, &body);
gfc_add_block_to_block (&se.pre, &loop.pre);
gfc_add_block_to_block (&se.pre, &loop.post);
+ gfc_add_block_to_block (&se.pre, &se.post);
gfc_cleanup_loop (&loop);
}
*************** gfc_trans_forall_1 (gfc_code * code, for
*** 2539,2546 ****
/* Explicit subroutine calls are prevented by the frontend but interface
assignments can legitimately produce them. */
! case EXEC_CALL:
! assign = gfc_trans_call (c);
tmp = gfc_trans_nested_forall_loop (nested_forall_info, assign, 1, 1);
gfc_add_expr_to_block (&block, tmp);
break;
--- 2665,2672 ----
/* Explicit subroutine calls are prevented by the frontend but interface
assignments can legitimately produce them. */
! case EXEC_ASSIGN_CALL:
! assign = gfc_trans_call (c, true);
tmp = gfc_trans_nested_forall_loop (nested_forall_info, assign, 1, 1);
gfc_add_expr_to_block (&block, tmp);
break;
Index: gcc/fortran/trans-stmt.h
===================================================================
*** gcc/fortran/trans-stmt.h (revision 113593)
--- gcc/fortran/trans-stmt.h (working copy)
*************** tree gfc_trans_goto (gfc_code *);
*** 38,44 ****
tree gfc_trans_entry (gfc_code *);
tree gfc_trans_pause (gfc_code *);
tree gfc_trans_stop (gfc_code *);
! tree gfc_trans_call (gfc_code *);
tree gfc_trans_return (gfc_code *);
tree gfc_trans_if (gfc_code *);
tree gfc_trans_arithmetic_if (gfc_code *);
--- 38,44 ----
tree gfc_trans_entry (gfc_code *);
tree gfc_trans_pause (gfc_code *);
tree gfc_trans_stop (gfc_code *);
! tree gfc_trans_call (gfc_code *, bool);
tree gfc_trans_return (gfc_code *);
tree gfc_trans_if (gfc_code *);
tree gfc_trans_arithmetic_if (gfc_code *);
Index: gcc/fortran/trans.c
===================================================================
*** gcc/fortran/trans.c (revision 113593)
--- gcc/fortran/trans.c (working copy)
*************** gfc_trans_code (gfc_code * code)
*** 494,500 ****
break;
case EXEC_CALL:
! res = gfc_trans_call (code);
break;
case EXEC_RETURN:
--- 494,504 ----
break;
case EXEC_CALL:
! res = gfc_trans_call (code, false);
! break;
!
! case EXEC_ASSIGN_CALL:
! res = gfc_trans_call (code, true);
break;
case EXEC_RETURN:
Index: gcc/fortran/st.c
===================================================================
*** gcc/fortran/st.c (revision 113593)
--- gcc/fortran/st.c (working copy)
*************** gfc_free_statement (gfc_code * p)
*** 112,117 ****
--- 112,118 ----
break;
case EXEC_CALL:
+ case EXEC_ASSIGN_CALL:
gfc_free_actual_arglist (p->ext.actual);
break;
Index: gcc/fortran/dependency.c
===================================================================
*** gcc/fortran/dependency.c (revision 113593)
--- gcc/fortran/dependency.c (working copy)
*************** gfc_check_fncall_dependency (gfc_expr *
*** 513,518 ****
--- 513,522 ----
if (!expr)
continue;
+ /* Skip other itself. */
+ if (expr == other)
+ continue;
+
/* Skip intent(in) arguments if OTHER itself is intent(in). */
if (formal
&& intent == INTENT_IN