From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: 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 Authentication-Results: sourceware.org; dmarc=pass (p=none dis=none) header.from=gmx.de Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=gmx.de DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=gmx.de; s=s31663417; t=1692647313; x=1693252113; i=anlauf@gmx.de; bh=/k7Pi3AnJs9pd/FBqMYG288Eim1G7XadFnD4vTLLg0U=; h=X-UI-Sender-Class:From:To:Subject:Date; b=Zk8xPKFlZae46pYT1WYUCtCVPchap5LWyLHLYwYQVAGlrAcfpHXDP4pP351lEcHxO5OLhjS w6mkoX8rCgkMt3PenyMAL9ABX8Jax1A1RTbZ+jOKKujSJi247duj2s0nikuSTjIAC0JAs/e6n iedQNi+/SSy+V1ZytsAeG0qalkMKF+/nt8QoeErCie52LSEE/Dcez6gjm9gP3VWUzxG3Uib5F OcywfUm2CYc74YACk0qzKjTqrLfJQpmVlXv+E5MJ1xmM+NYyI5e3IWM5O0Pmvg6sq567IGQnh PW5KKVHS7C5IDlIJjZIy1WCOn5+g96YI1avjO3rpNafGkatMB3Mg== 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: From: Harald Anlauf To: fortran , gcc-patches Subject: [PATCH] Fortran: implement vector sections in DATA statements [PR49588] Content-Type: multipart/mixed; boundary=trekuen-a532ca7a-88ad-4695-bf29-2f5eb844498c 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 List-Id: --trekuen-a532ca7a-88ad-4695-bf29-2f5eb844498c Content-Type: text/plain; charset=UTF-8 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 --trekuen-a532ca7a-88ad-4695-bf29-2f5eb844498c Content-Type: text/x-patch Content-Disposition: attachment; filename=pr49588.diff Content-Transfer-Encoding: quoted-printable =46rom 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. =2D-- 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 =2D-- 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 =3D 0; i < ar->dimen; i++) { - if (ar->dimen_type[i] !=3D DIMEN_RANGE) - continue; + bool advance =3D false; - if (ar->stride[i]) + switch (ar->dimen_type[i]) { - stride =3D 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) >=3D 0) - forwards =3D true; + case DIMEN_ELEMENT: + /* Loop to advance the next index. */ + advance =3D true; + break; + + case DIMEN_RANGE: + if (ar->stride[i]) + { + stride =3D 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) >=3D 0) + forwards =3D true; + else + forwards =3D false; + gfc_free_expr(stride); + } else - forwards =3D false; - gfc_free_expr(stride); - } - else - { - mpz_add_ui (section_index[i], section_index[i], 1); - forwards =3D true; - } + { + mpz_add_ui (section_index[i], section_index[i], 1); + forwards =3D true; + } - if (ar->end[i]) - { - end =3D gfc_copy_expr(ar->end[i]); - if(!gfc_simplify_expr(end, 1)) - gfc_internal_error("Simplification error"); - cmp =3D mpz_cmp (section_index[i], end->value.integer); - gfc_free_expr(end); - } - else - cmp =3D mpz_cmp (section_index[i], ar->as->upper[i]->value.integer); + if (ar->end[i]) + { + end =3D gfc_copy_expr(ar->end[i]); + if(!gfc_simplify_expr(end, 1)) + gfc_internal_error("Simplification error"); + cmp =3D mpz_cmp (section_index[i], end->value.integer); + gfc_free_expr(end); + } + else + cmp =3D 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 =3D 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 =3D 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 =3D true; + } + break; + + case DIMEN_VECTOR: + vector_offset[i]++; + base =3D ar->start[i]->value.constructor; + elem =3D gfc_constructor_lookup_expr (base, vector_offset[i]); + + if (elem =3D=3D NULL) + { + /* Reset to first vector element and advance the next index. */ + vector_offset[i] =3D 0; + elem =3D gfc_constructor_lookup_expr (base, 0); + advance =3D true; + } + if (elem) + { + start =3D 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 *of= fset) +gfc_get_section_index (gfc_array_ref *ar, mpz_t *section_index, mpz_t *of= fset, + 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 *sec= tion_index, mpz_t *offset) { case DIMEN_ELEMENT: case DIMEN_RANGE: - if (ar->start[i]) - { - start =3D 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 =3D ar->start[i]; break; case DIMEN_VECTOR: - gfc_internal_error ("TODO: Vector sections in data statements"); + vector_offset[i] =3D 0; + base =3D ar->start[i]->value.constructor; + elem =3D gfc_constructor_lookup_expr (base, vector_offset[i]); + break; default: gcc_unreachable (); } + if (elem) + { + start =3D 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 =2D-- 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 =2D-- 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 =3D 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 =3D &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 =3D 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 =3D=3D 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/tests= uite/gfortran.dg/data_vector_section.f90 new file mode 100644 index 00000000000..3e099de99d0 =2D-- /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=3D1,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=3D1,3),j=3D1,2) + if (.not. all (a =3D=3D [1,2,1,3,1,2,1,5])) stop 1 + if (.not. all (b =3D=3D reshape ([((10*i+j,i=3D1,3),j=3D1,2)], shape (b= )))) stop 2 +end program test =2D- 2.35.3 --trekuen-a532ca7a-88ad-4695-bf29-2f5eb844498c--