From patchwork Wed Jul 22 12:21:06 2015 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: Mikael Morin X-Patchwork-Id: 498514 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by ozlabs.org (Postfix) with ESMTPS id 0BCBC1402B8 for ; Wed, 22 Jul 2015 22:21:51 +1000 (AEST) Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b=obpHAYHc; dkim-atps=neutral DomainKey-Signature: a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:from :subject:to:references:cc:message-id:date:mime-version :in-reply-to:content-type; q=dns; s=default; b=f783DlfQdcFtofxYs 8x8B//Wq9FrtjLkf9I8MlWvGgWTkwZuvcCjuwT4//TZrJ92JBJE8frkdTQNdFAuP 0uVNViJVy7FZizk7b0o2EvKybgAYtH2q3GHom72B+xehO3ww/Xzt+b2mf0X+0dWp ZwX43i/ELe2mBoJoCwIsg8R7fw= DKIM-Signature: v=1; a=rsa-sha1; c=relaxed; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:from :subject:to:references:cc:message-id:date:mime-version :in-reply-to:content-type; s=default; bh=QbzFRjLpNme8gmOT4sALRtR DAKI=; b=obpHAYHcdn4WanxNBiBSbfcwPEm8Kr8E3+SDAHHOysc43zASAnnmRF4 WCztud20JEZCWZHPSww0XKM4NlvudcKevFiWbMbe3xse2KS6E6n+12B55gbyvd+3 94G7WzlZUzLBK5VSiPcHzw1a1am+3KlwtlmQ6PPvCv4g+s30kusI= Received: (qmail 911 invoked by alias); 22 Jul 2015 12:21:44 -0000 Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org Received: (qmail 889 invoked by uid 89); 22 Jul 2015 12:21:43 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=-2.1 required=5.0 tests=AWL, BAYES_00, KAM_STOCKGEN, RCVD_IN_DNSWL_LOW, RP_MATCHES_RCVD, SPF_PASS autolearn=ham version=3.3.2 X-Spam-User: qpsmtpd, 2 recipients X-HELO: smtp26.services.sfr.fr Received: from smtp26.services.sfr.fr (HELO smtp26.services.sfr.fr) (93.17.128.163) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with (AES256-GCM-SHA384 encrypted) ESMTPS; Wed, 22 Jul 2015 12:21:41 +0000 Received: from filter.sfr.fr (localhost [86.72.15.136]) by msfrf2604.sfr.fr (SMTP Server) with ESMTP id 15BC71C00241E; Wed, 22 Jul 2015 14:21:37 +0200 (CEST) Authentication-Results: sfrmc.priv.atos.fr; dkim=none (no signature); dkim-adsp=none (no policy) header.from=mikael.morin@sfr.fr Received: from tolstoi.localhost (136.15.72.86.rev.sfr.net [86.72.15.136]) (using TLSv1.2 with cipher DHE-RSA-AES128-SHA (128/128 bits)) (No client certificate requested) by msfrf2604.sfr.fr (SMTP Server) with ESMTP id 3E4721C00240E; Wed, 22 Jul 2015 14:21:36 +0200 (CEST) X-SFR-UUID: 20150722122136255.3E4721C00240E@msfrf2604.sfr.fr From: Mikael Morin Subject: Re: [Patch, fortran] PR 37131, inline matmul To: Thomas Koenig , Thomas Schwinge , Bernd Schmidt References: <55486270.8010909@netcologne.de> <5548BE61.1090506@sfr.fr> <554A78F7.5010300@netcologne.de> <87vbdnzvd4.fsf@kepler.schwinge.homeip.net> <55AD6E53.90800@netcologne.de> <55AE80D3.1070600@sfr.fr> <55AEA258.8060902@netcologne.de> Cc: gcc-patches , "fortran@gcc.gnu.org" Message-ID: <55AF8AB2.2000700@sfr.fr> Date: Wed, 22 Jul 2015 14:21:06 +0200 User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:38.0) Gecko/20100101 Thunderbird/38.1.0 MIME-Version: 1.0 In-Reply-To: <55AEA258.8060902@netcologne.de> X-IsSubscribed: yes 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 * 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 * 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;