From patchwork Mon Aug 21 19:48:33 2023 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Harald Anlauf X-Patchwork-Id: 136422 Return-Path: Delivered-To: ouuuleilei@gmail.com Received: by 2002:a59:b82d:0:b0:3f2:4152:657d with SMTP id z13csp3222017vqi; Mon, 21 Aug 2023 12:49:39 -0700 (PDT) X-Google-Smtp-Source: AGHT+IFTEBDiyyt6PJALqI4nnU8YG5TNZrYV7GlUMScX6PiB26eUXZ8gTWCDzR6fWrY4RCT3MZVq X-Received: by 2002:a05:6402:3586:b0:522:b9ae:db3c with SMTP id y6-20020a056402358600b00522b9aedb3cmr7691763edc.6.1692647378799; Mon, 21 Aug 2023 12:49:38 -0700 (PDT) ARC-Seal: i=1; a=rsa-sha256; t=1692647378; cv=none; d=google.com; s=arc-20160816; b=D19wWvSGNMKpgPKgvY+K6FOVSdQM+4nh8aXznRK8l9j0F1/BJdJPYJgR9KLPdnc+EP eepZdHKszRsZv+O4SWlwIHZTwIo+Rg5gDGJ3ywIO1GytxvM/VUHcdD1/IqvTpEoI2U/h ANnpjli/CKxXgOyD3FCVbIZY+lMWas6FS1NySpbZTdgmA7cCjKIAYIaEfut6NCZeRH7F 0CwEIjA5QHRNbhCnDoPanJ55NXrDjvFOacoANPpCySMFGlSL1eW8myZoPDlStLLYXbEi DCwww+4nhGoOiI8LtRVzAudpWqMFxOnzz8sNu4MZdwEA7ko8k4oPUoK3zUTtP7J62y8d aunQ== ARC-Message-Signature: i=1; a=rsa-sha256; c=relaxed/relaxed; d=google.com; s=arc-20160816; h=sender:errors-to:reply-to:from:list-subscribe:list-help:list-post :list-archive:list-unsubscribe:list-id:precedence:ui-outboundreport :sensitivity:importance:date:subject:to:message-id:mime-version :dmarc-filter:delivered-to:dkim-signature:dkim-filter; bh=DSR79tsPpRN3GCJnttFwZcOcamdt+MwvA+5IMijce2U=; fh=QK0YdXSiSCa48e9o4Ff7k6xpBN/ax2bSUZqWzYlsl7Q=; b=yYOdw6YL8++AAa0UdFyM15MPBUG3svJ850Fz0LdPt5ifOa2IHT01KlvHJ0EeWOFVpF mq0BhUyolU0bgghAp8qs8/o5WK+2GzC5wL52ejBPPEdtrJxkP2PaeznfK3ubz9HLP2Xk tHUUCEpneU5gGhbzZWYVZV8sP3+ZGvd4i6JFj/8yrh75UmKi+2cPeNkfyHozfjUjPMHV qky89ufaC5GngCqU9ACXcecbDAywJJ2QFetcxQsCIPh4Dgo1Aj40NKpvgj3/3Hu+FYyX tOuKRDppRUaJHuOqGbbgn1NHcUe/u1094mfbAJTcxcRCIti3Ywj1ckhZfP5NHwi5PZiL 95Tg== ARC-Authentication-Results: i=1; mx.google.com; dkim=pass header.i=@gcc.gnu.org header.s=default header.b="KQ8Dy/as"; spf=pass (google.com: domain of gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org designates 2620:52:3:1:0:246e:9693:128c as permitted sender) smtp.mailfrom="gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org"; dmarc=pass (p=NONE sp=NONE dis=NONE) header.from=gnu.org Received: from server2.sourceware.org (server2.sourceware.org. [2620:52:3:1:0:246e:9693:128c]) by mx.google.com with ESMTPS id ay15-20020a056402202f00b00528894fe377si6355117edb.1.2023.08.21.12.49.38 for (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Mon, 21 Aug 2023 12:49:38 -0700 (PDT) Received-SPF: pass (google.com: domain of gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org designates 2620:52:3:1:0:246e:9693:128c as permitted sender) client-ip=2620:52:3:1:0:246e:9693:128c; Authentication-Results: mx.google.com; dkim=pass header.i=@gcc.gnu.org header.s=default header.b="KQ8Dy/as"; spf=pass (google.com: domain of gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org designates 2620:52:3:1:0:246e:9693:128c as permitted sender) smtp.mailfrom="gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org"; dmarc=pass (p=NONE sp=NONE dis=NONE) header.from=gnu.org Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 46A1F3856974 for ; Mon, 21 Aug 2023 19:49:37 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 46A1F3856974 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gcc.gnu.org; s=default; t=1692647377; bh=DSR79tsPpRN3GCJnttFwZcOcamdt+MwvA+5IMijce2U=; h=To:Subject:Date:List-Id:List-Unsubscribe:List-Archive:List-Post: List-Help:List-Subscribe:From:Reply-To:From; b=KQ8Dy/ashQyA5bm4//ck20scYsCFtYQgmFP0p7NaZc8ZNL/CxVIqJPT+WOC7ToghO +Zxtfb7AHOf8KMMDGp/ObTImrzAhzyywgLyPInQDSEjG78cnHRI+Q+JCtCUlDPsjdb l9xFfOmLG7qbpIhraUhT3Bgo8L/zWXm3BvGoxXOs= X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from mout.gmx.net (mout.gmx.net [212.227.15.15]) by sourceware.org (Postfix) with ESMTPS id B13933858D37; Mon, 21 Aug 2023 19:48:34 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org B13933858D37 X-UI-Sender-Class: 724b4f7f-cbec-4199-ad4e-598c01a50d3a Received: from [79.251.9.162] ([79.251.9.162]) by web-mail.gmx.net (3c-app-gmx-bs15.server.lan [172.19.170.67]) (via HTTP); Mon, 21 Aug 2023 21:48:33 +0200 MIME-Version: 1.0 Message-ID: To: fortran , gcc-patches Subject: [PATCH] Fortran: implement vector sections in DATA statements [PR49588] Date: Mon, 21 Aug 2023 21:48:33 +0200 Importance: normal Sensitivity: Normal X-Priority: 3 X-Provags-ID: V03:K1:ErRE3AL22nwsYxZ0mPWp+HBl9KvaqUTtSe0HDzDPJu3ZCTGPA7jMVAQDeQJGKUyccGT4+ mKtnTGS78JFM45m4uUlnX1KNtflgB4Mpa3Mo/oCRZxSw/pUMCM952KdQkzYofHIgIhOa5t+fUrW/ 7q4ykCwpOXCWHvOt0gDsdhZe/7rJhBpHDI6eadfQW4vgVA8sIdbkptVnIbNDbSoM8IRN0zxp2e8h s/ZGZCdgBnzZVEhavgMLd96Z/mwW3KWXKRYw3WRaeWJjPNp06B0Pzsx3qeO7ydzKFFhGBJF09C8O Jc= UI-OutboundReport: notjunk:1;M01:P0:iljglmAu7A8=;73BrYOu+xkS32a/v8kxAe7NoAMf v4z0+ICPSTtcyWTnLQJdtBmouTSgqnH77rCeNV9pMYCm8uRpn6cIvWuRDCfyIVHikMph4bSMG KoT7cfJAGgJ9RB8ahdJwzIYdIZHA4GsCLUDB/vKulqTzWAkb6fE8zVNXwUIsyqhBQzub6ovKl ZRcYrNappxQst8xTddK7g+umJnmBU45lgNYZkd9qRNzdgjzaeXDUJsQ5MjGyTgUGKTAlrnH5n XuZnTE+9WL3hAbJENi6gbpAc8wCPhux7A+mo8xnzy/G7/Redy6JDuXuAVK/cBBt2n6bvFh8df PZ90zsEdkxvqb+Lwzy/r5XRNezDPcTTOaXMZnBBwXXcmRJ1071ZUCBVY+hnBeP0obISov95JW m0glsHAwTCdsdZDYq9er4xYwtPpou48uUAswxHLgyJU94JzBmp+HHA5Bg+VFpZqhqezzK+8KO qGWhe9CPzvHjj+YUDJ9yxB5CeW0AhTglnOzmXgZyPrXeoSkswkBZfm617b6gfKV+SrFCn7iqz S3xk3VJOzu9j7r+7QrMUw+8GBbXgn1rdKYrowb91fOOb3hsYtBEln1HNpnoqfMYzJv2N6qxU7 ut21JtT5oI4VXWuOMoh+ajfPOents2kX2Z1SqnS1Mpii6EK/HfgQB6HGiWVYYg7vWiAfj5/ku fSUtMG8vNN3Yc5CoJweGjTdtsCfrzhtyspSQJY9yiASeJ7hWZZ6ObOi8mmJ35lvWAWKntGMfr R11GcBRFLPm6hzHbVM/zQGTugoTnJh/gk/neVTXP4u+nBgU0SzNPiIDaR88ZB/Uw1PSkKPdxv FJ/DI5g8k1K4tzd5/CxzleL1sOTE8HQB9rXbLvZwg87AY= X-Spam-Status: No, score=-12.6 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, DKIM_VALID_AU, DKIM_VALID_EF, FREEMAIL_FROM, GIT_PATCH_0, KAM_SHORT, RCVD_IN_DNSWL_LOW, RCVD_IN_MSPIKE_H4, RCVD_IN_MSPIKE_WL, SPF_HELO_NONE, SPF_PASS, TXREP autolearn=ham autolearn_force=no version=3.4.6 X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on server2.sourceware.org X-BeenThere: gcc-patches@gcc.gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , X-Patchwork-Original-From: Harald Anlauf via Gcc-patches From: Harald Anlauf Reply-To: Harald Anlauf Errors-To: gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org Sender: "Gcc-patches" X-getmail-retrieved-from-mailbox: INBOX X-GMAIL-THRID: 1774869417572871670 X-GMAIL-MSGID: 1774869417572871670 Dear all, the attached patch implements vector sections in DATA statements. The implementation is simpler than the size of the patch suggests, as part of changes try to clean up the existing code to make it easier to understand, as ordinary sections (start:end:stride) and vector sections may actually share some common code. The basisc idea of the implementation is that one needs a temporary vector that keeps track of the offsets into the array constructors for the indices in the array reference that are vectors. Regtested on x86_64-pc-linux-gnu. OK for mainline? Thanks, Harald From 96cc0333cdaa8459ef516ae8e74158cdb6302853 Mon Sep 17 00:00:00 2001 From: Harald Anlauf Date: Mon, 21 Aug 2023 21:23:57 +0200 Subject: [PATCH] Fortran: implement vector sections in DATA statements [PR49588] gcc/fortran/ChangeLog: PR fortran/49588 * data.cc (gfc_advance_section): Derive next index set and next offset into DATA variable also for array references using vector sections. Use auxiliary array to keep track of offsets into indexing vectors. (gfc_get_section_index): Set up initial indices also for DATA variables with array references using vector sections. * data.h (gfc_get_section_index): Adjust prototype. (gfc_advance_section): Likewise. * resolve.cc (check_data_variable): Pass vector offsets. gcc/testsuite/ChangeLog: PR fortran/49588 * gfortran.dg/data_vector_section.f90: New test. --- gcc/fortran/data.cc | 161 +++++++++++------- gcc/fortran/data.h | 4 +- gcc/fortran/resolve.cc | 5 +- .../gfortran.dg/data_vector_section.f90 | 26 +++ 4 files changed, 134 insertions(+), 62 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/data_vector_section.f90 diff --git a/gcc/fortran/data.cc b/gcc/fortran/data.cc index d29eb12c1b1..7c2537dd3f0 100644 --- a/gcc/fortran/data.cc +++ b/gcc/fortran/data.cc @@ -634,65 +634,102 @@ abort: void gfc_advance_section (mpz_t *section_index, gfc_array_ref *ar, - mpz_t *offset_ret) + mpz_t *offset_ret, int *vector_offset) { int i; mpz_t delta; mpz_t tmp; bool forwards; int cmp; - gfc_expr *start, *end, *stride; + gfc_expr *start, *end, *stride, *elem; + gfc_constructor_base base; for (i = 0; i < ar->dimen; i++) { - if (ar->dimen_type[i] != DIMEN_RANGE) - continue; + bool advance = false; - if (ar->stride[i]) + switch (ar->dimen_type[i]) { - stride = gfc_copy_expr(ar->stride[i]); - if(!gfc_simplify_expr(stride, 1)) - gfc_internal_error("Simplification error"); - mpz_add (section_index[i], section_index[i], - stride->value.integer); - if (mpz_cmp_si (stride->value.integer, 0) >= 0) - forwards = true; + case DIMEN_ELEMENT: + /* Loop to advance the next index. */ + advance = true; + break; + + case DIMEN_RANGE: + if (ar->stride[i]) + { + stride = gfc_copy_expr(ar->stride[i]); + if(!gfc_simplify_expr(stride, 1)) + gfc_internal_error("Simplification error"); + mpz_add (section_index[i], section_index[i], + stride->value.integer); + if (mpz_cmp_si (stride->value.integer, 0) >= 0) + forwards = true; + else + forwards = false; + gfc_free_expr(stride); + } else - forwards = false; - gfc_free_expr(stride); - } - else - { - mpz_add_ui (section_index[i], section_index[i], 1); - forwards = true; - } + { + mpz_add_ui (section_index[i], section_index[i], 1); + forwards = true; + } - if (ar->end[i]) - { - end = gfc_copy_expr(ar->end[i]); - if(!gfc_simplify_expr(end, 1)) - gfc_internal_error("Simplification error"); - cmp = mpz_cmp (section_index[i], end->value.integer); - gfc_free_expr(end); - } - else - cmp = mpz_cmp (section_index[i], ar->as->upper[i]->value.integer); + if (ar->end[i]) + { + end = gfc_copy_expr(ar->end[i]); + if(!gfc_simplify_expr(end, 1)) + gfc_internal_error("Simplification error"); + cmp = mpz_cmp (section_index[i], end->value.integer); + gfc_free_expr(end); + } + else + cmp = mpz_cmp (section_index[i], ar->as->upper[i]->value.integer); - if ((cmp > 0 && forwards) || (cmp < 0 && !forwards)) - { - /* Reset index to start, then loop to advance the next index. */ - if (ar->start[i]) + if ((cmp > 0 && forwards) || (cmp < 0 && !forwards)) { - start = gfc_copy_expr(ar->start[i]); - if(!gfc_simplify_expr(start, 1)) - gfc_internal_error("Simplification error"); + /* Reset index to start, then loop to advance the next index. */ + if (ar->start[i]) + { + start = gfc_copy_expr(ar->start[i]); + if(!gfc_simplify_expr(start, 1)) + gfc_internal_error("Simplification error"); + mpz_set (section_index[i], start->value.integer); + gfc_free_expr(start); + } + else + mpz_set (section_index[i], ar->as->lower[i]->value.integer); + advance = true; + } + break; + + case DIMEN_VECTOR: + vector_offset[i]++; + base = ar->start[i]->value.constructor; + elem = gfc_constructor_lookup_expr (base, vector_offset[i]); + + if (elem == NULL) + { + /* Reset to first vector element and advance the next index. */ + vector_offset[i] = 0; + elem = gfc_constructor_lookup_expr (base, 0); + advance = true; + } + if (elem) + { + start = gfc_copy_expr (elem); + if (!gfc_simplify_expr (start, 1)) + gfc_internal_error ("Simplification error"); mpz_set (section_index[i], start->value.integer); - gfc_free_expr(start); + gfc_free_expr (start); } - else - mpz_set (section_index[i], ar->as->lower[i]->value.integer); + break; + + default: + gcc_unreachable (); } - else + + if (!advance) break; } @@ -793,12 +830,14 @@ gfc_formalize_init_value (gfc_symbol *sym) offset. */ void -gfc_get_section_index (gfc_array_ref *ar, mpz_t *section_index, mpz_t *offset) +gfc_get_section_index (gfc_array_ref *ar, mpz_t *section_index, mpz_t *offset, + int *vector_offset) { int i; mpz_t delta; mpz_t tmp; - gfc_expr *start; + gfc_expr *start, *elem; + gfc_constructor_base base; mpz_set_si (*offset, 0); mpz_init (tmp); @@ -810,29 +849,35 @@ gfc_get_section_index (gfc_array_ref *ar, mpz_t *section_index, mpz_t *offset) { case DIMEN_ELEMENT: case DIMEN_RANGE: - if (ar->start[i]) - { - start = gfc_copy_expr(ar->start[i]); - if(!gfc_simplify_expr(start, 1)) - gfc_internal_error("Simplification error"); - mpz_sub (tmp, start->value.integer, - ar->as->lower[i]->value.integer); - mpz_mul (tmp, tmp, delta); - mpz_add (*offset, tmp, *offset); - mpz_set (section_index[i], start->value.integer); - gfc_free_expr(start); - } - else - mpz_set (section_index[i], ar->as->lower[i]->value.integer); + elem = ar->start[i]; break; case DIMEN_VECTOR: - gfc_internal_error ("TODO: Vector sections in data statements"); + vector_offset[i] = 0; + base = ar->start[i]->value.constructor; + elem = gfc_constructor_lookup_expr (base, vector_offset[i]); + break; default: gcc_unreachable (); } + if (elem) + { + start = gfc_copy_expr (elem); + if (!gfc_simplify_expr (start, 1)) + gfc_internal_error ("Simplification error"); + mpz_sub (tmp, start->value.integer, + ar->as->lower[i]->value.integer); + mpz_mul (tmp, tmp, delta); + mpz_add (*offset, tmp, *offset); + mpz_set (section_index[i], start->value.integer); + gfc_free_expr (start); + } + else + /* Fallback for empty section or constructor. */ + mpz_set (section_index[i], ar->as->lower[i]->value.integer); + mpz_sub (tmp, ar->as->upper[i]->value.integer, ar->as->lower[i]->value.integer); mpz_add_ui (tmp, tmp, 1); diff --git a/gcc/fortran/data.h b/gcc/fortran/data.h index 40dbee1ef28..8f2013ac894 100644 --- a/gcc/fortran/data.h +++ b/gcc/fortran/data.h @@ -18,6 +18,6 @@ along with GCC; see the file COPYING3. If not see . */ void gfc_formalize_init_value (gfc_symbol *); -void gfc_get_section_index (gfc_array_ref *, mpz_t *, mpz_t *); +void gfc_get_section_index (gfc_array_ref *, mpz_t *, mpz_t *, int *); bool gfc_assign_data_value (gfc_expr *, gfc_expr *, mpz_t, mpz_t *); -void gfc_advance_section (mpz_t *, gfc_array_ref *, mpz_t *); +void gfc_advance_section (mpz_t *, gfc_array_ref *, mpz_t *, int *); diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc index f51674f7faa..ce8261d646a 100644 --- a/gcc/fortran/resolve.cc +++ b/gcc/fortran/resolve.cc @@ -16765,6 +16765,7 @@ check_data_variable (gfc_data_variable *var, locus *where) ar_type mark = AR_UNKNOWN; int i; mpz_t section_index[GFC_MAX_DIMENSIONS]; + int vector_offset[GFC_MAX_DIMENSIONS]; gfc_ref *ref; gfc_array_ref *ar; gfc_symbol *sym; @@ -16888,7 +16889,7 @@ check_data_variable (gfc_data_variable *var, locus *where) case AR_SECTION: ar = &ref->u.ar; /* Get the start position of array section. */ - gfc_get_section_index (ar, section_index, &offset); + gfc_get_section_index (ar, section_index, &offset, vector_offset); mark = AR_SECTION; break; @@ -16971,7 +16972,7 @@ check_data_variable (gfc_data_variable *var, locus *where) /* Modify the array section indexes and recalculate the offset for next element. */ else if (mark == AR_SECTION) - gfc_advance_section (section_index, ar, &offset); + gfc_advance_section (section_index, ar, &offset, vector_offset); } } diff --git a/gcc/testsuite/gfortran.dg/data_vector_section.f90 b/gcc/testsuite/gfortran.dg/data_vector_section.f90 new file mode 100644 index 00000000000..3e099de99d0 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/data_vector_section.f90 @@ -0,0 +1,26 @@ +! { dg-do run } +! PR fortran/49588 - vector sections in data statements + +block data + implicit none + integer :: a(8), b(3,2), i + data a(::2) /4*1/ + data a([2,6]) /2*2/ + data a([4]) /3/ + data a([(6+2*i,i=1,1)]) /1*5/ + data b( 1 ,[1,2]) /11,12/ + data b([2,3],[2,1]) /22,32,21,31/ + common /com/ a, b +end block data + +program test + implicit none + integer :: a(8), b(3,2), i, j + common /com/ a, b + print *, a + print *, b +! print *, a - [1,2,1,3,1,2,1,5] +! print *, ((b(i,j)-(10*i+j),i=1,3),j=1,2) + if (.not. all (a == [1,2,1,3,1,2,1,5])) stop 1 + if (.not. all (b == reshape ([((10*i+j,i=1,3),j=1,2)], shape (b)))) stop 2 +end program test -- 2.35.3