From patchwork Wed Dec 17 23:14:18 2014 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: Tobias Burnus X-Patchwork-Id: 422404 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 258C21400E9 for ; Thu, 18 Dec 2014 10:14:33 +1100 (AEDT) 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=t8AMcAOpV0grm+KccP6H9EvmQu4tc5avwngb+XM8aCJFdd WYyRWTOpDdEwHe/L9JUrtwUI9pBc8xVQ2Ce+MfNjve9LLBtjSfkDFGcbAloPsBRL 6rcj3MzNyRZeA6rpV6mNqmRs8A36atYqsJk77Wo2KZNb7BZyvLil5wvTcEBR0= 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=az70XB/IkQhbRqK5yXD1V/IDhFs=; b=lEfWPPARwtS179Mbgi9H 2ld2WhYhS9Vdi35SrIklMlXe1yNcm24Y2TqyH6syWmSzuyaip7tUnFf9+3E3O3bb nFuOVSJuyGDLn5Fr1JPCgS2oogBr7UKquoz2zhNqOPPKHCbXu1DJkNkKGSiDXPv9 1r4Dl59/bbBXiPLvbXb5VXU= Received: (qmail 10728 invoked by alias); 17 Dec 2014 23:14:26 -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 10702 invoked by uid 89); 17 Dec 2014 23:14:25 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=1.0 required=5.0 tests=AWL, BAYES_20, RCVD_IN_DNSWL_LOW, UNWANTED_LANGUAGE_BODY autolearn=ham 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; Wed, 17 Dec 2014 23:14:23 +0000 Received: from tux.net-b.de (port-92-194-124-106.dynamic.qsc.de [92.194.124.106]) (using TLSv1 with cipher DHE-RSA-AES256-SHA (256/256 bits)) (No client certificate requested) by mx02.qsc.de (Postfix) with ESMTPSA id 6D80D2760C; Thu, 18 Dec 2014 00:14:19 +0100 (CET) Message-ID: <54920E4A.4030003@net-b.de> Date: Thu, 18 Dec 2014 00:14:18 +0100 From: Tobias Burnus User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:31.0) Gecko/20100101 Thunderbird/31.3.0 MIME-Version: 1.0 To: gcc-patches , gfortran , Alessandro Fanfarillo Subject: [Patch, Fortran] -fcoarray=lib: Fix vector subscript handling As testing by Alessandro revealed, vector subscripts weren't properly handled. This patch fixes the compiler side (or at least those issues I found). In particular, for expressions ("get") it wrongly passed a NULL pointer, additionally, I used the wrong "ar". For it and for assignments/push ("send", "sendget"), I also used the wrong rank value as one also passes DIMEN_ELEMENT as DIMEN_RANGE. Build and regtested on x86-64-gnu-linux. OK for the trunk? * * * I still have to add vector subscript support to libcaf_single. I didn't include an -fdump-tree-original test case, but I can add one if there regarded as useful. Attached is – besides the patch for trans-intrinsic.c – a debuging patch for libcaf_single. I tested it with: integer :: A(2,3)[*] A(2,:) = A(1,[1,3,2])[1] end integer :: A(2,3)[*] A(1,[1,3,2])[1] = A(2,:) end integer :: A(2,3)[*] integer :: B(2,3)[*] A(1,[1,3,2])[1] = B(1,[1,3,2])[1] end The output looks like (for the first one): DEBUG: CAF_GET: 0x7fffb72f71d0 DEBUG: have vector for rank 2 [1] DEBUG: dim=0: nvec = 0 DEBUG: (1:1:1) DEBUG: dim=1: nvec = 3 DEBUG: 0: 1 DEBUG: 1: 3 DEBUG: 2: 2 Tobias diff --git a/libgfortran/caf/single.c b/libgfortran/caf/single.c index 632d172..2c6d5ae 100644 --- a/libgfortran/caf/single.c +++ b/libgfortran/caf/single.c @@ -543,7 +543,7 @@ void _gfortran_caf_get (caf_token_t token, size_t offset, int image_index __attribute__ ((unused)), gfc_descriptor_t *src, - caf_vector_t *src_vector __attribute__ ((unused)), + caf_vector_t *src_vector, gfc_descriptor_t *dest, int src_kind, int dst_kind, bool may_require_tmp) { @@ -551,9 +551,43 @@ _gfortran_caf_get (caf_token_t token, size_t offset, size_t i, k, size; int j; int rank = GFC_DESCRIPTOR_RANK (dest); + int src_rank = GFC_DESCRIPTOR_RANK (src); size_t src_size = GFC_DESCRIPTOR_SIZE (src); size_t dst_size = GFC_DESCRIPTOR_SIZE (dest); + if (src_vector) +{ +__builtin_printf("DEBUG: CAF_GET: %p\n", src_vector); +__builtin_printf("DEBUG: have vector for rank %d [%d]\n", src_rank, rank); +for (j=0; j < src_rank; j++) +{ +__builtin_printf("DEBUG: dim=%d: nvec = %u\n", j, src_vector[j].nvec); +if (src_vector[j].nvec == 0) + __builtin_printf("DEBUG: (%lu:%lu:%lu)\n", + src_vector[j].u.triplet.lower_bound, + src_vector[j].u.triplet.upper_bound, + src_vector[j].u.triplet.stride); +for (i=0; i < src_vector[j].nvec; i++) +switch (src_vector[j].u.v.kind) { + case 1: + __builtin_printf("DEBUG: %lu: %d\n", i, ((int8_t *)src_vector[j].u.v.vector)[i]); + break; + case 2: + __builtin_printf("DEBUG: %lu: %d\n", i, ((int16_t *)src_vector[j].u.v.vector)[i]); + break; + case 4: + __builtin_printf("DEBUG: %lu: %d\n", i, ((int32_t *)src_vector[j].u.v.vector)[i]); + break; + case 8: + __builtin_printf("DEBUG: %lu: %ld\n", i, (long)((int64_t *)src_vector[j].u.v.vector)[i]); + break; +/* case 16: + __builtin_printf("DEBUG: %lu: %ld\n", i, (long)((__int128 *)src_vector[j].u.v.vector)[i]); + break;*/ +} +} +} + if (rank == 0) { void *sr = (void *) ((char *) TOKEN (token) + offset); @@ -744,6 +778,39 @@ _gfortran_caf_send (caf_token_t token, size_t offset, size_t src_size = GFC_DESCRIPTOR_SIZE (src); size_t dst_size = GFC_DESCRIPTOR_SIZE (dest); + if (dst_vector) +{ +__builtin_printf("DEBUG: CAF_SEND: %p\n", dst_vector); +__builtin_printf("DEBUG: have vector for rank %d\n", rank); +for (j=0; j < rank; j++) +{ +__builtin_printf("DEBUG: dim=%d: nvec = %u\n", j, dst_vector[j].nvec); +if (dst_vector[j].nvec == 0) + __builtin_printf("DEBUG: (%lu:%lu:%lu)\n", + dst_vector[j].u.triplet.lower_bound, + dst_vector[j].u.triplet.upper_bound, + dst_vector[j].u.triplet.stride); +for (i=0; i < dst_vector[j].nvec; i++) +switch (dst_vector[j].u.v.kind) { + case 1: + __builtin_printf("DEBUG: %lu: %d\n", i, ((int8_t *)dst_vector[j].u.v.vector)[i]); + break; + case 2: + __builtin_printf("DEBUG: %lu: %d\n", i, ((int16_t *)dst_vector[j].u.v.vector)[i]); + break; + case 4: + __builtin_printf("DEBUG: %lu: %d\n", i, ((int32_t *)dst_vector[j].u.v.vector)[i]); + break; + case 8: + __builtin_printf("DEBUG: %lu: %ld\n", i, (long)((int64_t *)dst_vector[j].u.v.vector)[i]); + break; +/* case 16: + __builtin_printf("DEBUG: %lu: %ld\n", i, (long)((__int128 *)dst_vector[j].u.v.vector)[i]); + break;*/ +} +} +} + if (rank == 0) { void *dst = (void *) ((char *) TOKEN (token) + offset); @@ -948,6 +1015,44 @@ _gfortran_caf_sendget (caf_token_t dst_token, size_t dst_offset, /* FIXME: Handle vector subscript of 'src_vector'. */ /* For a single image, src->base_addr should be the same as src_token + offset but to play save, we do it properly. */ + + int src_rank = GFC_DESCRIPTOR_RANK (src); + size_t i, k, size; + int j; + if (src_vector) +{ +__builtin_printf("DEBUG: CAF_SENDGET: %p / %p\n", dst_vector, src_vector); +__builtin_printf("DEBUG: have src vector for rank %d\n", src_rank); +for (j=0; j < src_rank; j++) +{ +__builtin_printf("DEBUG: dim=%d: nvec = %u\n", j, src_vector[j].nvec); +if (src_vector[j].nvec == 0) + __builtin_printf("DEBUG: (%lu:%lu:%lu)\n", + src_vector[j].u.triplet.lower_bound, + src_vector[j].u.triplet.upper_bound, + src_vector[j].u.triplet.stride); +for (i=0; i < src_vector[j].nvec; i++) +switch (src_vector[j].u.v.kind) { + case 1: + __builtin_printf("DEBUG: %lu: %d\n", i, ((int8_t *)src_vector[j].u.v.vector)[i]); + break; + case 2: + __builtin_printf("DEBUG: %lu: %d\n", i, ((int16_t *)src_vector[j].u.v.vector)[i]); + break; + case 4: + __builtin_printf("DEBUG: %lu: %d\n", i, ((int32_t *)src_vector[j].u.v.vector)[i]); + break; + case 8: + __builtin_printf("DEBUG: %lu: %ld\n", i, (long)((int64_t *)src_vector[j].u.v.vector)[i]); + break; +/* case 16: + __builtin_printf("DEBUG: %lu: %ld\n", i, (long)((__int128 *)src_vector[j].u.v.vector)[i]); + break;*/ +} +} +} + + void *src_base = GFC_DESCRIPTOR_DATA (src); GFC_DESCRIPTOR_DATA (src) = (void *) ((char *) TOKEN (src_token) + src_offset); _gfortran_caf_send (dst_token, dst_offset, dst_image_index, dest, dst_vector,