OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

trans-expr.c (conv_isocbinding_procedure): New function. 

2009-11-19  Janus Weil  <janus@gcc.gnu.org>

	* trans-expr.c (conv_isocbinding_procedure): New function.
	(gfc_conv_procedure_call): Move ISO_C_BINDING stuff to
	separate function.

From-SVN: r154327
This commit is contained in:
Janus Weil 2009-11-19 11:29:41 +01:00
parent dae5882f9c
commit 08fbe2fe5e
2 changed files with 153 additions and 124 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
gcc/fortran/ChangeLog
View File

@ -1,3 +1,9 @@
2009-11-19 Janus Weil <janus@gcc.gnu.org>
* trans-expr.c (conv_isocbinding_procedure): New function.
(gfc_conv_procedure_call): Move ISO_C_BINDING stuff to
separate function.
2009-11-19 Tobias Burnus <burnus@net-b.de>
* gfortran.texi (Interoperable Subroutines and Functions): Fix

119
gcc/fortran/trans-expr.c
View File

@ -2533,51 +2533,23 @@ conv_arglist_function (gfc_se *se, gfc_expr *expr, const char *name)
}
/* Generate code for a procedure call. Note can return se->post != NULL.
If se->direct_byref is set then se->expr contains the return parameter.
Return nonzero, if the call has alternate specifiers.
'expr' is only needed for procedure pointer components. */
/* The following routine generates code for the intrinsic
procedures from the ISO_C_BINDING module:
* C_LOC (function)
* C_FUNLOC (function)
* C_F_POINTER (subroutine)
* C_F_PROCPOINTER (subroutine)
* C_ASSOCIATED (function)
One exception which is not handled here is C_F_POINTER with non-scalar
arguments. Returns 1 if the call was replaced by inline code (else: 0). */
int
gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
gfc_actual_arglist * arg, gfc_expr * expr,
tree append_args)
static int
conv_isocbinding_procedure (gfc_se * se, gfc_symbol * sym,
gfc_actual_arglist * arg)
{
gfc_interface_mapping mapping;
tree arglist;
tree retargs;
tree tmp;
tree fntype;
gfc_se parmse;
gfc_ss *argss;
gfc_ss_info *info;
int byref;
int parm_kind;
tree type;
tree var;
tree len;
tree stringargs;
gfc_formal_arglist *formal;
int has_alternate_specifier = 0;
bool need_interface_mapping;
bool callee_alloc;
gfc_typespec ts;
gfc_charlen cl;
gfc_expr *e;
gfc_symbol *fsym;
stmtblock_t post;
enum {MISSING = 0, ELEMENTAL, SCALAR, SCALAR_POINTER, ARRAY};
gfc_component *comp = NULL;
gfc_ss *argss;
arglist = NULL_TREE;
retargs = NULL_TREE;
stringargs = NULL_TREE;
var = NULL_TREE;
len = NULL_TREE;
gfc_clear_ts (&ts);
if (sym->from_intmod == INTMOD_ISO_C_BINDING)
{
if (sym->intmod_sym_id == ISOCBINDING_LOC)
{
if (arg->expr->rank == 0)
@ -2600,14 +2572,14 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
NULL, NULL, NULL);
}
/* TODO -- the following two lines shouldn't be necessary, but
they're removed a bug is exposed later in the codepath.
This is workaround was thus introduced, but will have to be
/* TODO -- the following two lines shouldn't be necessary, but if
they're removed, a bug is exposed later in the code path.
This workaround was thus introduced, but will have to be
removed; please see PR 35150 for details about the issue. */
se->expr = convert (pvoid_type_node, se->expr);
se->expr = gfc_evaluate_now (se->expr, &se->pre);
return 0;
return 1;
}
else if (sym->intmod_sym_id == ISOCBINDING_FUNLOC)
{
@ -2616,7 +2588,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
arg->expr->ts.kind = sym->ts.u.derived->ts.kind;
gfc_conv_expr_reference (se, arg->expr);
return 0;
return 1;
}
else if ((sym->intmod_sym_id == ISOCBINDING_F_POINTER
&& arg->next->expr->rank == 0)
@ -2651,7 +2623,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
fold_convert (TREE_TYPE (fptrse.expr),
cptrse.expr));
return 0;
return 1;
}
else if (sym->intmod_sym_id == ISOCBINDING_ASSOCIATED)
{
@ -2697,9 +2669,60 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
not_null_expr, eq_expr);
}
return 1;
}
/* Nothing was done. */
return 0;
}
}
/* Generate code for a procedure call. Note can return se->post != NULL.
If se->direct_byref is set then se->expr contains the return parameter.
Return nonzero, if the call has alternate specifiers.
'expr' is only needed for procedure pointer components. */
int
gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
gfc_actual_arglist * arg, gfc_expr * expr,
tree append_args)
{
gfc_interface_mapping mapping;
tree arglist;
tree retargs;
tree tmp;
tree fntype;
gfc_se parmse;
gfc_ss *argss;
gfc_ss_info *info;
int byref;
int parm_kind;
tree type;
tree var;
tree len;
tree stringargs;
gfc_formal_arglist *formal;
int has_alternate_specifier = 0;
bool need_interface_mapping;
bool callee_alloc;
gfc_typespec ts;
gfc_charlen cl;
gfc_expr *e;
gfc_symbol *fsym;
stmtblock_t post;
enum {MISSING = 0, ELEMENTAL, SCALAR, SCALAR_POINTER, ARRAY};
gfc_component *comp = NULL;
arglist = NULL_TREE;
retargs = NULL_TREE;
stringargs = NULL_TREE;
var = NULL_TREE;
len = NULL_TREE;
gfc_clear_ts (&ts);
if (sym->from_intmod == INTMOD_ISO_C_BINDING
&& conv_isocbinding_procedure (se, sym, arg))
return 0;
gfc_is_proc_ptr_comp (expr, &comp);