From patchwork Sat Mar 15 08:52:18 2014 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Tobias Burnus X-Patchwork-Id: 330625 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 5E1472C00CA for ; Sat, 15 Mar 2014 19:52:38 +1100 (EST) DomainKey-Signature: a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender :message-id:date:from:mime-version:to:subject:content-type; q= dns; s=default; b=JbXcskGjfT3iMoCAiHhjqcHP5n3L66TnJ9PP2Gf2jfFHPJ MkuFE3Tf4Rx4qb8eC7Rgs2K1mKKMYPKwI0qE9uhcqb67+tffVIXp7AbGr/dnPMs9 e3q0uLQh59r8n9vi1CCYeHUjoPm2x0schp/yS8Um1lUL3zlrK8QAOQ4NqCzgw= 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 :message-id:date:from:mime-version:to:subject:content-type; s= default; bh=TOAiZElUmp7Fccz9BDZvrHqj9Y4=; b=dVj1ydJCc1ncmoTxUBfO ra1Ui5KzTPwrwKy4aOFBRGQZf9/Luuilz95lSxfFVk4Tlzzt7ziaCyjSTuxsO6mP Lb+/tmDqDO45XDA/cw//feuYkwGDAAJueTB9unIKRwXySCbXR+zC9dY1a92k99F4 uwUQiVuMt8bK5lqiun95+J0= Received: (qmail 8005 invoked by alias); 15 Mar 2014 08:52:25 -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 7980 invoked by uid 89); 15 Mar 2014 08:52:24 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=-0.2 required=5.0 tests=AWL, BAYES_00, KAM_STOCKGEN, RCVD_IN_DNSWL_NONE autolearn=no version=3.3.2 X-Spam-User: qpsmtpd, 2 recipients X-HELO: mx02.qsc.de Received: from mx02.qsc.de (HELO mx02.qsc.de) (213.148.130.14) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with (AES256-SHA encrypted) ESMTPS; Sat, 15 Mar 2014 08:52:23 +0000 Received: from tux.net-b.de (port-92-194-27-75.dynamic.qsc.de [92.194.27.75]) (using TLSv1 with cipher DHE-RSA-AES256-SHA (256/256 bits)) (No client certificate requested) by mx02.qsc.de (Postfix) with ESMTPSA id BB40F27618; Sat, 15 Mar 2014 09:52:19 +0100 (CET) Message-ID: <532414C2.6080100@net-b.de> Date: Sat, 15 Mar 2014 09:52:18 +0100 From: Tobias Burnus User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Thunderbird/24.3.0 MIME-Version: 1.0 To: gcc-patches , gfortran Subject: [Fortran-CAF, Patch, committed] Add caf_send intrinsic The patch adds a new internal-only intrinsic "caf_send", which replaces assignments to coindexed variables, i.e. caf[i] = rhs becomes _F.caf_send (caf[i], rhs, async=.false.) The idea is that this replacement makes it easier to do optimizations in the front-end optimization pass (fortran/frontend-passes.c) - for instance, by turning the caf_send(...async=.false.) into a pair of async=.true. and a later wait. In addition, it was the simplest way to divert the access into a dedicated function in trans-intrinsic.c This patch only adds the intrinsic - and the (disabled, "false &&") replacement of the assignment by a the intrinsic call. The actual handling in trans-intrinsic.c is still missing. Teaser: I do have a working & tested patch, which implements the library call, but that patch still needs some clean up. Committed to the Fortran-CAF branch as Rev. 208589 Tobias Index: gfortran.h =================================================================== --- gfortran.h (Revision 208587) +++ gfortran.h (Arbeitskopie) @@ -323,6 +323,7 @@ enum gfc_isym_id GFC_ISYM_CHDIR, GFC_ISYM_CHMOD, GFC_ISYM_CMPLX, + GFC_ISYM_CAF_SEND, GFC_ISYM_COMMAND_ARGUMENT_COUNT, GFC_ISYM_COMPILER_OPTIONS, GFC_ISYM_COMPILER_VERSION, Index: intrinsic.c =================================================================== --- intrinsic.c (Revision 208587) +++ intrinsic.c (Arbeitskopie) @@ -2756,7 +2756,7 @@ add_functions (void) make_generic ("size", GFC_ISYM_SIZE, GFC_STD_F95); /* Obtain the stride for a given dimensions; to be used only internally. - "make_from_module" makes inaccessible for external users. */ + "make_from_module" makes it inaccessible for external users. */ add_sym_2 (GFC_PREFIX ("stride"), GFC_ISYM_STRIDE, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, gfc_index_integer_kind, GFC_STD_GNU, NULL, NULL, gfc_resolve_stride, @@ -3209,6 +3209,16 @@ add_subroutines (void) "fptr", BT_UNKNOWN, 0, REQUIRED, INTENT_OUT); make_from_module(); + /* The following function is internally used for coarray libray functions. + "make_from_module" makes it inaccessible for external users. */ + add_sym_3s (GFC_PREFIX ("caf_send"), GFC_ISYM_CAF_SEND, CLASS_IMPURE, + BT_UNKNOWN, 0, GFC_STD_GNU, NULL, NULL, NULL, + "x", BT_REAL, dr, REQUIRED, INTENT_OUT, + "y", BT_REAL, dr, REQUIRED, INTENT_IN, + "async", BT_LOGICAL, dl, REQUIRED, INTENT_IN); + make_from_module(); + + /* More G77 compatibility garbage. */ add_sym_3s ("alarm", GFC_ISYM_ALARM, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU, gfc_check_alarm_sub, NULL, gfc_resolve_alarm_sub, Index: resolve.c =================================================================== --- resolve.c (Revision 208587) +++ resolve.c (Arbeitskopie) @@ -9217,8 +9217,10 @@ resolve_ordinary_assign (gfc_code *code, gfc_names return false; } + bool lhs_coindexed = gfc_is_coindexed (lhs); + /* F2008, Section 7.2.1.2. */ - if (gfc_is_coindexed (lhs) && gfc_has_ultimate_allocatable (lhs)) + if (lhs_coindexed && gfc_has_ultimate_allocatable (lhs)) { gfc_error ("Coindexed variable must not have an allocatable ultimate " "component in assignment at %L", &lhs->where); @@ -9226,6 +9228,28 @@ resolve_ordinary_assign (gfc_code *code, gfc_names } gfc_check_assign (lhs, rhs, 1); + + if (false && lhs_coindexed && gfc_option.coarray == GFC_FCOARRAY_LIB) + { + code->op = EXEC_CALL; + gfc_get_sym_tree (GFC_PREFIX ("caf_send"), ns, &code->symtree, true); + code->resolved_sym = code->symtree->n.sym; + code->resolved_sym->attr.flavor = FL_PROCEDURE; + code->resolved_sym->attr.intrinsic = 1; + code->resolved_sym->attr.subroutine = 1; + code->resolved_isym = gfc_intrinsic_subroutine_by_id (GFC_ISYM_CAF_SEND); + gfc_commit_symbol (code->resolved_sym); + code->ext.actual = gfc_get_actual_arglist (); + code->ext.actual->expr = lhs; + code->ext.actual->next = gfc_get_actual_arglist (); + code->ext.actual->next->expr = rhs; + code->ext.actual->next->next = gfc_get_actual_arglist (); + code->ext.actual->next->next->expr = + gfc_get_logical_expr (gfc_default_logical_kind, NULL, false); + code->expr1 = NULL; + code->expr2 = NULL; + } + return false; } @@ -9861,7 +9885,7 @@ resolve_code (gfc_code *code, gfc_namespace *ns) } /* F03 7.4.1.3 for non-allocatable, non-pointer components. */ - if (code->expr1->ts.type == BT_DERIVED + if (code->op != EXEC_CALL && code->expr1->ts.type == BT_DERIVED && code->expr1->ts.u.derived->attr.defined_assign_comp) generate_component_assignments (&code, ns);