Le 21/07/2015 21:49, Thomas Koenig a écrit :
Am 21.07.2015 um 19:26 schrieb Mikael Morin:
I would like to avoid the hack in iresolve. So let's reuse the
frontend-passes.c part of my patch (set resolved_isym)
I would much prefer if that was put into gfc_resolve_fe_runtime_error,
next to the assignment to c->resolved_sym.
Makes sense.
and then handle
it in gfc_conv_intrinsic_subroutine, the way my patch does it (I'm not
sure it actually fixes anything) or some other way (set
resolved_sym->backend_decl as in iresolve, ...).
It does actually fix the issue. One way of constructing a test case
is to run
$ gfortran -fdump-tree-optimized -fno-realloc-lhs -fcheck=all -O -S
inline_matmul_2.f90
and count the number of calls to "_gfortran_runtime_error " in the
*.optimized dump (without the _at). It should be zero.
So, OK from my side with the change above and corresponding test case.
This is what it looks like.
However, it introduces regressions on matmul_bounds_{2,4,5}.
It seems the "incorrect extent" runtime errors are completely optimized
away (even at -O0).
Any ideas?
Mikael
2015-07-22 Mikael Morin <[email protected]>
* iresolve.c (gfc_resolve_fe_runtime_error): Set c->resolved_isym.
* tran-intrinsic.c (gfc_conv_intrinsic_function_args,
conv_intrinsic_procedure_args): Factor the non-function-specific code
from the former into the latter.
(gfc_intrinsic_argument_list_length, intrinsic_argument_list_length):
Ditto.
(gfc_conv_intrinsic_lib_function, conv_intrinsic_lib_procedure):
Ditto.
(gfc_conv_intrinsic_lib_function, find_intrinsic_map):
Factor out from the former into the latter.
(conv_intrinsic_runtime_error): New function.
(gfc_conv_intrinsic_subroutine): Call it
in the GFC_ISYM_FE_RUNTIME_ERROR case.
2015-07-22 Mikael Morin <[email protected]>
* gfortran.dg/inline_matmul_12.f90: New.
diff --git a/gcc/fortran/iresolve.c b/gcc/fortran/iresolve.c
index 9dab49e..1ccd93d 100644
--- a/gcc/fortran/iresolve.c
+++ b/gcc/fortran/iresolve.c
@@ -2208,6 +2208,7 @@ gfc_resolve_fe_runtime_error (gfc_code *c)
a->name = "%VAL";
c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
+ c->resolved_isym = gfc_intrinsic_subroutine_by_id (GFC_ISYM_FE_RUNTIME_ERROR);
}
void
diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index 1155481..bed8a1e 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -195,18 +195,14 @@ gfc_builtin_decl_for_float_kind (enum built_in_function double_built_in,
generated code to be ignored. */
static void
-gfc_conv_intrinsic_function_args (gfc_se *se, gfc_expr *expr,
- tree *argarray, int nargs)
+conv_intrinsic_procedure_args (gfc_se *se, gfc_intrinsic_arg *formal,
+ gfc_actual_arglist *actual, tree *argarray,
+ int nargs)
{
- gfc_actual_arglist *actual;
gfc_expr *e;
- gfc_intrinsic_arg *formal;
gfc_se argse;
int curr_arg;
- formal = expr->value.function.isym->formal;
- actual = expr->value.function.actual;
-
for (curr_arg = 0; curr_arg < nargs; curr_arg++,
actual = actual->next,
formal = formal ? formal->next : NULL)
@@ -248,16 +244,29 @@ gfc_conv_intrinsic_function_args (gfc_se *se, gfc_expr *expr,
}
}
+
+static void
+gfc_conv_intrinsic_function_args (gfc_se *se, gfc_expr *expr,
+ tree *argarray, int nargs)
+{
+ gfc_actual_arglist *actual;
+ gfc_intrinsic_arg *formal;
+
+ formal = expr->value.function.isym->formal;
+ actual = expr->value.function.actual;
+ conv_intrinsic_procedure_args (se, formal, actual, argarray, nargs);
+}
+
+
/* Count the number of actual arguments to the intrinsic function EXPR
including any "hidden" string length arguments. */
static unsigned int
-gfc_intrinsic_argument_list_length (gfc_expr *expr)
+intrinsic_argument_list_length (gfc_actual_arglist *actual)
{
int n = 0;
- gfc_actual_arglist *actual;
- for (actual = expr->value.function.actual; actual; actual = actual->next)
+ for (; actual; actual = actual->next)
{
if (!actual->expr)
continue;
@@ -272,6 +281,13 @@ gfc_intrinsic_argument_list_length (gfc_expr *expr)
}
+static unsigned int
+gfc_intrinsic_argument_list_length (gfc_expr *expr)
+{
+ return intrinsic_argument_list_length (expr->value.function.actual);
+}
+
+
/* Conversions between different types are output by the frontend as
intrinsic functions. We implement these directly with inline code. */
@@ -837,17 +853,31 @@ gfc_get_intrinsic_lib_fndecl (gfc_intrinsic_map_t * m, gfc_expr * expr)
/* Convert an intrinsic function into an external or builtin call. */
static void
-gfc_conv_intrinsic_lib_function (gfc_se * se, gfc_expr * expr)
+conv_intrinsic_lib_procedure (gfc_se * se, tree fndecl,
+ gfc_intrinsic_arg * formal,
+ gfc_actual_arglist * actual)
{
- gfc_intrinsic_map_t *m;
- tree fndecl;
tree rettype;
tree *args;
unsigned int num_args;
- gfc_isym_id id;
- id = expr->value.function.isym->id;
- /* Find the entry for this function. */
+ /* Get the decl and generate the call. */
+ num_args = intrinsic_argument_list_length (actual);
+ args = XALLOCAVEC (tree, num_args);
+
+ conv_intrinsic_procedure_args (se, formal, actual, args, num_args);
+ rettype = TREE_TYPE (TREE_TYPE (fndecl));
+
+ fndecl = build_addr (fndecl, current_function_decl);
+ se->expr = build_call_array_loc (input_location, rettype, fndecl, num_args, args);
+}
+
+
+static gfc_intrinsic_map_t *
+find_intrinsic_map (enum gfc_isym_id id, const char *name)
+{
+ gfc_intrinsic_map_t *m;
+
for (m = gfc_intrinsic_map;
m->id != GFC_ISYM_NONE || m->double_built_in != END_BUILTINS; m++)
{
@@ -858,19 +888,32 @@ gfc_conv_intrinsic_lib_function (gfc_se * se, gfc_expr * expr)
if (m->id == GFC_ISYM_NONE)
{
gfc_internal_error ("Intrinsic function %qs (%d) not recognized",
- expr->value.function.name, id);
+ name, id);
}
- /* Get the decl and generate the call. */
- num_args = gfc_intrinsic_argument_list_length (expr);
- args = XALLOCAVEC (tree, num_args);
+ return m;
+}
- gfc_conv_intrinsic_function_args (se, expr, args, num_args);
+
+/* Convert an intrinsic function into an external or builtin call. */
+
+static void
+gfc_conv_intrinsic_lib_function (gfc_se * se, gfc_expr * expr)
+{
+ gfc_intrinsic_map_t *m;
+ tree fndecl;
+ gfc_isym_id id;
+ gfc_intrinsic_arg *formal;
+ gfc_actual_arglist *actual;
+
+ id = expr->value.function.isym->id;
+ m = find_intrinsic_map (id, expr->value.function.name);
fndecl = gfc_get_intrinsic_lib_fndecl (m, expr);
- rettype = TREE_TYPE (TREE_TYPE (fndecl));
- fndecl = build_addr (fndecl, current_function_decl);
- se->expr = build_call_array_loc (input_location, rettype, fndecl, num_args, args);
+ formal = expr->value.function.isym->formal;
+ actual = expr->value.function.actual;
+
+ conv_intrinsic_lib_procedure (se, fndecl, formal, actual);
}
@@ -9481,6 +9524,23 @@ conv_intrinsic_move_alloc (gfc_code *code)
}
+static tree
+conv_intrinsic_runtime_error (gfc_code *c)
+{
+ stmtblock_t block;
+ gfc_se se;
+
+ gfc_start_block (&block);
+
+ gfc_init_se (&se, NULL);
+ conv_intrinsic_lib_procedure (&se, gfor_fndecl_runtime_error,
+ c->resolved_isym->formal,
+ c->ext.actual);
+
+ return gfc_finish_block (&block);
+}
+
+
tree
gfc_conv_intrinsic_subroutine (gfc_code *code)
{
@@ -9531,6 +9591,10 @@ gfc_conv_intrinsic_subroutine (gfc_code *code)
res = conv_co_collective (code);
break;
+ case GFC_ISYM_FE_RUNTIME_ERROR:
+ res = conv_intrinsic_runtime_error (code);
+ break;
+
case GFC_ISYM_SYSTEM_CLOCK:
res = conv_intrinsic_system_clock (code);
break;
! { dg-do compile }
! { dg-options "-fcheck=all -fno-realloc-lhs -O -fdump-tree-original -fdump-tree-optimized" }
!
! Check that the runtime_error call generated by the inline matmul
! uses the proper function decl, and thus can be optimized away.
!
! Test based on matmul_bounds_2.f90
program main
real, dimension(3,2) :: a
real, dimension(2,3) :: b
real, dimension(:,:), allocatable :: ret
allocate (ret(2,2))
a = 1.0
b = 2.3
ret = matmul(b,a) ! This is OK
deallocate(ret)
allocate(ret(3,2))
ret = matmul(a,b) ! This should throw an error.
end program main
! { dg-final { scan-tree-dump-times "_gfortran_runtime_error *\\(" 2 "original" } }
! { dg-final { scan-tree-dump-times "_gfortran_runtime_error *\\(" 0 "optimized" } }
