From patchwork Thu Nov 26 17:55:54 2015 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Alessandro Fanfarillo X-Patchwork-Id: 549202 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 6A6FB1402D4 for ; Fri, 27 Nov 2015 04:56:11 +1100 (AEDT) Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b=BzPjFD8P; 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 :mime-version:in-reply-to:references:date:message-id:subject :from:to:cc:content-type; q=dns; s=default; b=qEAQd0FzE0Z6LC+7oF hSOp+wyeDoSsW0vx7bNvM/g1o8f3aEBSNkzxmBpjT+hI+cwcqjXMPj6rUHQ000ma hSpfAeqR1byUwIAqt4xm+PnZBVHoT7m5VvHTkZoQDKFFcWC8IA+jyVhSCKO8E3Ru YHbS7w4dqaZTFMLv8B6J0NIPQ= 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 :mime-version:in-reply-to:references:date:message-id:subject :from:to:cc:content-type; s=default; bh=W1g3B7wbHZGjZEP/KispaePp I3w=; b=BzPjFD8PaKRdA2cpkFjPEOYMRx1Edhtc7u/8OFKkZFVPKpbkmtTbj8qn qgIm7Mpu0KWtscPI4XUL6jIn6SDLShbRwQS4zQzPSyXFwIFcVRfs+0YoVj8BT+NU +hfuBPW+xFxWiB4z+/AW+5SCiACk/G1M77Khb4Je5WOyTcRtEUg= Received: (qmail 20137 invoked by alias); 26 Nov 2015 17:55:59 -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 20117 invoked by uid 89); 26 Nov 2015 17:55:59 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=-0.4 required=5.0 tests=AWL, BAYES_50, FREEMAIL_FROM, RCVD_IN_DNSWL_LOW, SPF_PASS autolearn=ham version=3.3.2 X-Spam-User: qpsmtpd, 2 recipients X-HELO: mail-ig0-f182.google.com Received: from mail-ig0-f182.google.com (HELO mail-ig0-f182.google.com) (209.85.213.182) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with (AES128-GCM-SHA256 encrypted) ESMTPS; Thu, 26 Nov 2015 17:55:57 +0000 Received: by igcph11 with SMTP id ph11so14650055igc.1; Thu, 26 Nov 2015 09:55:55 -0800 (PST) MIME-Version: 1.0 X-Received: by 10.50.155.4 with SMTP id vs4mr4157502igb.34.1448560555092; Thu, 26 Nov 2015 09:55:55 -0800 (PST) Received: by 10.107.34.75 with HTTP; Thu, 26 Nov 2015 09:55:54 -0800 (PST) In-Reply-To: <20151126165109.GA69466@troutmask.apl.washington.edu> References: <20150429075505.GA21015@physik.fu-berlin.de> <20151126165109.GA69466@troutmask.apl.washington.edu> Date: Thu, 26 Nov 2015 18:55:54 +0100 Message-ID: Subject: Re: [Fortran, Patch] (RFC, Coarray) Implement TS18508's EVENTS From: Alessandro Fanfarillo To: Steve Kargl Cc: Tobias Burnus , gcc-patches , gfortran X-IsSubscribed: yes Hi all, in attachment the patch for tests and missing functions in libcaf_single (needed by the test suite). Built and regtested on x86_64-pc-linux-gnu. 2015-11-26 17:51 GMT+01:00 Steve Kargl : > On Wed, Nov 25, 2015 at 06:24:49PM +0100, Alessandro Fanfarillo wrote: >> Dear all, >> >> in attachment the previous patch compatible with the current trunk. >> The patch also includes the changes introduced in the latest TS 18508. >> >> Built and regtested on x86_64-pc-linux-gnu. >> >> PS: I will add the test cases in a different patch. >> > > I have now built and regression tested the patch on > x86_64-*-freebsd and i386-*-freebsd. There were no > regressions. In reading through the patch, nothing > jumped out at me as suspicious/wrong. Tobias, this > is OK to commit. If you don't committed by Sunday, > I'll do it for you. > > -- > steve commit d68b49bae714a7b5881587a61d30d643fa0cdb90 Author: Alessandro Fanfarillo Date: Thu Nov 26 18:51:47 2015 +0100 New tests for coarray events and new functions in libcaf_single diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index e0b16f5..bcc99ea 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,9 @@ +2015-11-26 Tobias Burnus + Alessandro Fanfarillo + + * gfortran.dg/coarray/event_1.f90: New. + * gfortran.dg/coarray/event_2.f90: New. + 2015-11-25 Markus Trippelsdorf Paolo Carlini diff --git a/gcc/testsuite/gfortran.dg/coarray/event_1.f90 b/gcc/testsuite/gfortran.dg/coarray/event_1.f90 new file mode 100644 index 0000000..b4385f3 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/coarray/event_1.f90 @@ -0,0 +1,51 @@ +! { dg-do run } +! +! Run-time test for EVENT_TYPE +! +use iso_fortran_env, only: event_type +implicit none + +type(event_type), save :: var[*] +integer :: count, stat + +count = -42 +call event_query (var, count) +if (count /= 0) call abort() + +stat = 99 +event post (var, stat=stat) +if (stat /= 0) call abort() +call event_query(var, count, stat=stat) +if (count /= 1 .or. stat /= 0) call abort() + +stat = 99 +event post (var[this_image()]) +call event_query(var, count) +if (count /= 2) call abort() + +stat = 99 +event wait (var) +call event_query(var, count) +if (count /= 1) call abort() + +stat = 99 +event post (var) +call event_query(var, count) +if (count /= 2) call abort() + +stat = 99 +event post (var) +call event_query(var, count) +if (count /= 3) call abort() + +stat = 99 +event wait (var, until_count=2) +call event_query(var, count) +if (count /= 1) call abort() + +stat = 99 +event wait (var, stat=stat, until_count=1) +if (stat /= 0) call abort() +call event_query(event=var, stat=stat, count=count) +if (count /= 0 .or. stat /= 0) call abort() +end diff --git a/gcc/testsuite/gfortran.dg/coarray/event_2.f90 b/gcc/testsuite/gfortran.dg/coarray/event_2.f90 new file mode 100644 index 0000000..2d451a5 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/coarray/event_2.f90 @@ -0,0 +1,89 @@ +! { dg-do run } +! +! Run-time test for EVENT_TYPE +! +use iso_fortran_env, only: event_type +implicit none + +type(event_type), save, allocatable :: var(:)[:] +integer :: count, stat + +allocate(var(3)[*]) + +count = -42 +call event_query (var(1), count) +if (count /= 0) call abort() +call event_query (var(1), count) +if (count /= 0) call abort() +call event_query (var(2), count) +if (count /= 0) call abort() +call event_query (var(3), count) +if (count /= 0) call abort() + +stat = 99 +event post (var(2), stat=stat) +if (stat /= 0) call abort() +call event_query (var(1), count) +if (count /= 0) call abort() +call event_query(var(2), count, stat=stat) +if (count /= 1 .or. stat /= 0) call abort() +call event_query (var(3), count) +if (count /= 0) call abort() + +stat = 99 +event post (var(2)[this_image()]) +call event_query(var(1), count) +if (count /= 0) call abort() +call event_query(var(2), count) +if (count /= 2) call abort() +call event_query(var(2), count) +if (count /= 2) call abort() +call event_query(var(3), count) +if (count /= 0) call abort() + +stat = 99 +event wait (var(2)) +call event_query(var(1), count) +if (count /= 0) call abort() +call event_query(var(2), count) +if (count /= 1) call abort() +call event_query(var(3), count) +if (count /= 0) call abort() + +stat = 99 +event post (var(2)) +call event_query(var(1), count) +if (count /= 0) call abort() +call event_query(var(2), count) +if (count /= 2) call abort() +call event_query(var(3), count) +if (count /= 0) call abort() + +stat = 99 +event post (var(2)) +call event_query(var(1), count) +if (count /= 0) call abort() +call event_query(var(2), count) +if (count /= 3) call abort() +call event_query(var(3), count) +if (count /= 0) call abort() + +stat = 99 +event wait (var(2), until_count=2) +call event_query(var(1), count) +if (count /= 0) call abort() +call event_query(var(2), count) +if (count /= 1) call abort() +call event_query(var(3), count) +if (count /= 0) call abort() + +stat = 99 +event wait (var(2), stat=stat, until_count=1) +if (stat /= 0) call abort() +call event_query(event=var(1), stat=stat, count=count) +if (count /= 0 .or. stat /= 0) call abort() +call event_query(event=var(2), stat=stat, count=count) +if (count /= 0 .or. stat /= 0) call abort() +call event_query(event=var(3), stat=stat, count=count) +if (count /= 0 .or. stat /= 0) call abort() +end diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog index 48db71b..4843fd5 100644 --- a/libgfortran/ChangeLog +++ b/libgfortran/ChangeLog @@ -1,3 +1,11 @@ +2015-11-26 Tobias Burnus + Alessandro Fanfarillo + + * caf/libcaf.h (_gfortran_caf_event_post, + _gfortran_caf_event_wait,_gfortran_caf_event_query): New prototypes. + * caf/single.c (_gfortran_caf_event_post, + _gfortran_caf_event_wait,_gfortran_caf_event_query): Implement. + 2015-11-22 Jerry DeLisle PR libfortran/52251 diff --git a/libgfortran/caf/libcaf.h b/libgfortran/caf/libcaf.h index 660bd7c..ebda579 100644 --- a/libgfortran/caf/libcaf.h +++ b/libgfortran/caf/libcaf.h @@ -57,7 +57,9 @@ typedef enum caf_register_t { CAF_REGTYPE_COARRAY_ALLOC, CAF_REGTYPE_LOCK_STATIC, CAF_REGTYPE_LOCK_ALLOC, - CAF_REGTYPE_CRITICAL + CAF_REGTYPE_CRITICAL, + CAF_REGTYPE_EVENT_STATIC, + CAF_REGTYPE_EVENT_ALLOC } caf_register_t; @@ -133,5 +135,8 @@ void _gfortran_caf_atomic_op (int, caf_token_t, size_t, int, void *, void *, void _gfortran_caf_lock (caf_token_t, size_t, int, int *, int *, char *, int); void _gfortran_caf_unlock (caf_token_t, size_t, int, int *, char *, int); +void _gfortran_caf_event_post (caf_token_t, size_t, int, int *, char *, int); +void _gfortran_caf_event_wait (caf_token_t, size_t, int, int *, char *, int); +void _gfortran_caf_event_query (caf_token_t, size_t, int, int *, int *); #endif /* LIBCAF_H */ diff --git a/libgfortran/caf/single.c b/libgfortran/caf/single.c index 6c58286..9c4b343 100644 --- a/libgfortran/caf/single.c +++ b/libgfortran/caf/single.c @@ -101,7 +101,8 @@ _gfortran_caf_register (size_t size, caf_register_t type, caf_token_t *token, void *local; if (type == CAF_REGTYPE_LOCK_STATIC || type == CAF_REGTYPE_LOCK_ALLOC - || type == CAF_REGTYPE_CRITICAL) + || type == CAF_REGTYPE_CRITICAL || type == CAF_REGTYPE_EVENT_STATIC + || type == CAF_REGTYPE_EVENT_ALLOC) local = calloc (size, sizeof (bool)); else local = malloc (size); @@ -133,7 +134,8 @@ _gfortran_caf_register (size_t size, caf_register_t type, caf_token_t *token, *stat = 0; if (type == CAF_REGTYPE_COARRAY_STATIC || type == CAF_REGTYPE_LOCK_STATIC - || type == CAF_REGTYPE_CRITICAL) + || type == CAF_REGTYPE_CRITICAL || type == CAF_REGTYPE_EVENT_STATIC + || type == CAF_REGTYPE_EVENT_ALLOC) { caf_static_t *tmp = malloc (sizeof (caf_static_t)); tmp->prev = caf_static_list; @@ -1071,6 +1073,45 @@ _gfortran_caf_atomic_op (int op, caf_token_t token, size_t offset, *stat = 0; } +void +_gfortran_caf_event_post (caf_token_t token, size_t index, + int image_index __attribute__ ((unused)), + int *stat, char *errmsg __attribute__ ((unused)), + int errmsg_len __attribute__ ((unused))) +{ + uint32_t value = 1; + uint32_t *event = (uint32_t *) ((char *) TOKEN (token) + index*sizeof(uint32_t)); + __atomic_fetch_add (event, (uint32_t) value, __ATOMIC_RELAXED); + + if(stat) + *stat = 0; +} + +void +_gfortran_caf_event_wait (caf_token_t token, size_t index, + int until_count, int *stat, + char *errmsg __attribute__ ((unused)), + int errmsg_len __attribute__ ((unused))) +{ + uint32_t *event = (uint32_t *) ((char *) TOKEN (token) + index*sizeof(uint32_t)); + uint32_t value = (uint32_t)-until_count; + __atomic_fetch_add (event, (uint32_t) value, __ATOMIC_RELAXED); + + if(stat) + *stat = 0; +} + +void +_gfortran_caf_event_query (caf_token_t token, size_t index, + int image_index __attribute__ ((unused)), + int *count, int *stat) +{ + uint32_t *event = (uint32_t *) ((char *) TOKEN (token) + index*sizeof(uint32_t)); + __atomic_load (event, (uint32_t *) count, __ATOMIC_RELAXED); + + if(stat) + *stat = 0; +} void _gfortran_caf_lock (caf_token_t token, size_t index,