From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mout.gmx.net (mout.gmx.net [212.227.15.18]) by sourceware.org (Postfix) with ESMTPS id 541F4385803F for ; Mon, 26 Apr 2021 10:36:59 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.3.2 sourceware.org 541F4385803F X-UI-Sender-Class: 01bb95c1-4bf8-414a-932a-4f6e2808ef9c Received: from vepi2 ([79.194.169.29]) by mail.gmx.net (mrgmx005 [212.227.17.190]) with ESMTPSA (Nemesis) id 1MTiPv-1m2r933XX3-00TzGk; Mon, 26 Apr 2021 12:36:40 +0200 Date: Mon, 26 Apr 2021 12:36:36 +0200 From: Andre Vehreschild To: Steve Kargl Cc: GCC-Fortran-ML , Damian Rouson , Andre Vehreschild Subject: Re: [Patch, Fortran, Update 2] PR98301 Re: RANDOM_INIT() and coarray Fortran Message-ID: <20210426123636.7eb24c37@vepi2> In-Reply-To: <20210425200334.GA94808@troutmask.apl.washington.edu> References: <20210403172846.GA14134@troutmask.apl.washington.edu> <20210404053331.GA18048@troutmask.apl.washington.edu> <20210423184357.643efbdf@vepi2> <20210423171817.GA75072@troutmask.apl.washington.edu> <20210424124945.46b1da51@vepi2> <20210425200334.GA94808@troutmask.apl.washington.edu> X-Mailer: Claws Mail 3.17.8 (GTK+ 2.24.33; x86_64-redhat-linux-gnu) MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="MP_/YbQAwlmXfyp2Nx.juMs.xSW" X-Provags-ID: V03:K1:2hy9C/7wl/b3ItCwFpv1GA6J9fglbes9Mh+ErGZ8aOdONc3sH7q AWrI0BYyeEu5mcgYx2ZtqYT9eKEGXhWiUT00Mt0aQKeNvrrpMlleeJIlnizMPpnaNtPXKUA dc+RqVDRPoPXosIJNzbLpXXb3mVQ/wJ6rf4jWeZJYyCWFIrij6vzJorgx0tDCdHoM+CtIMG 53E/2mFe0jMd9lwsKgbJg== X-UI-Out-Filterresults: notjunk:1;V03:K0:q4GjDKbV0rk=:vJsdy4u3Dk4mWReG54cs7S dT8tBbLW8JS5xve9FjFW8byxU25MkU8CvOWvd/heE7B12redzAY0fAhJ1+dz5t8/NXos76aX7 tpLW+qg0bRXTzLVO/I4WBVU2Y6f0Y0/o5yxGB+hvYYqxDX12BsEP1PwLLCHZdvyLqcKfxbV0t lh3VKsgbkrzC+mw50cL5LfxVEFYtYYVrpDn6+uQbN8eemuCziqnX6z548VpKJhZWX3mj+rCnV CVqrp49wwLA9EoE9Aqv9NcQmCQkrxxQwnix34HnlKjE/uYqc9GrZIRexleeMBlLt44rJIf3q7 arwJORifFYu0helNrIThP+0IJDeQ6Z1YY2/bl56jGqPeUmqLXTb1oDY43Boo1PmEXDGlJss/O NmYKCXJCXpTvItqwCkbPci7OlbrcQPE1uIrOoPFTSP6kr1dWL1UoX1sKZTGNtyJ91G/9BcH49 eqcIKhDbCxrmbzhiYP4qsJjzvg3ZuNhmka04kOrEtrzKLBywqzFqqifC/DUvmmOeQQhlS4iCI JWkx8ULElJ+p/JLfrDMCHy4sdUtaFZEM08E9/+oI740xC3yXKpXXp0WrYWO2E6W2Gj3WzWZ5v kEKl6U2PEv3mZ4uxP6HqMFY++s3/9T4Ydl5bRCOizp1+vSGUT+91lzBh8bvAlYNxGptGPlqCn 18A9jCHYWVlTcaujVj3r+lRLcavgqzPqfeC5KEAL5DfDNfsDhSf38YOpwMmpaVrP2FnTgxSpk NED1xSNfSV0Qo/sYWLOHm8LJ3MkfGkozvcQrR2Bvlr+jV9kemqtclai5JQ2YMJtytPVJB1iYb cCF1skjqD47m1j8/QlCvn5auATcF6WKkcj2noEqeAv0/w9iLUYCEaKc/slgfOIWjf1dR/evPl RctBr06yC18mTe+vHxq5FDKzeVU/5EDFX0xpf/NXILp978TPVX56D2kohZLeh8v2yjXS3eaH3 7IKZpY1GQhn7+/P0dLyK428FcEEOhKarskJ7Veu9g7dDt3YhW18PzJ+RJuA3+zVRG16+FFdc+ oA2nXHPo+RUky7smmrQwN5KlF0sLCTCrtEIcuFA2Ow5fD3DT5CDWAmqWDaTI3meriMx+/FUFo 7wKGqxXPj8g+FLhxeIMKVu03xMzPEfg3sFDdOR5s+8ObCfmAQQCrO90oFnGnNU7Y0XQ5Icwgt 9yxrGnybqv34gCAPWeI1HurE6gh0jLIfca7AUPxGYHgvIz/4a2cwwpnyEoqkAVzLGJJtE= X-Spam-Status: No, score=-10.4 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, FREEMAIL_FROM, GIT_PATCH_0, KAM_SHORT, RCVD_IN_DNSWL_LOW, RCVD_IN_MSPIKE_H2, SPF_HELO_NONE, SPF_PASS, TXREP autolearn=ham autolearn_force=no version=3.4.2 X-Spam-Checker-Version: SpamAssassin 3.4.2 (2018-09-13) on server2.sourceware.org X-BeenThere: fortran@gcc.gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Fortran mailing list List-Unsubscribe: , List-Archive: List-Help: List-Subscribe: , X-List-Received-Date: Mon, 26 Apr 2021 10:37:02 -0000 --MP_/YbQAwlmXfyp2Nx.juMs.xSW Content-Type: text/plain; charset=US-ASCII Content-Transfer-Encoding: quoted-printable Content-Disposition: inline Hi Steve, hi all, I agree. The cas-things have been removed (I will put the patch for them = into the pr98301 ticket, so safe them), streamlining the patch a bit more. Bootstraped and regtested ok on x86_64-linux/f33. Ok for trunk? Regards, Andre Steve Kargl PR fortran/98301 - random_init() is broken Correct implementation of random_init() when -fcoarray=3Dlib is given. gcc/fortran/ChangeLog: PR fortran/98301 * trans-decl.c (gfc_build_builtin_function_decls): Move decl. * trans-intrinsic.c (conv_intrinsic_random_init): Use bool for lib-call of caf_random_init instead of logical (4-byte). * trans.h: Add tree var for random_init. libgfortran/ChangeLog: PR fortran/98302 * caf/libcaf.h (_gfortran_caf_random_init): New function. * caf/single.c (_gfortran_caf_random_init): New function. * gfortran.map: Added fndecl. * intrinsics/random_init.f90: Implement random_init. On Sun, 25 Apr 2021 13:03:34 -0700 Steve Kargl wrote: > Andre, > > The patch looks fine to me. I wonder, however, if we should > comment out all of the shared memory stuff, i.e., the _cas_ > stuff. I don't know when Thomas/Nicolas will merge their > work-in-progress. > =2D- Andre Vehreschild * Email: vehre ad gmx dot de --MP_/YbQAwlmXfyp2Nx.juMs.xSW Content-Type: text/x-patch Content-Transfer-Encoding: quoted-printable Content-Disposition: attachment; filename=pr98301.patch diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index cc9d85543ca..7365dde47bf 100644 =2D-- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -170,6 +170,7 @@ tree gfor_fndecl_co_min; tree gfor_fndecl_co_reduce; tree gfor_fndecl_co_sum; tree gfor_fndecl_caf_is_present; +tree gfor_fndecl_caf_random_init; /* Math functions. Many other math functions are handled in @@ -233,7 +234,7 @@ tree gfor_fndecl_cgemm; tree gfor_fndecl_zgemm; /* RANDOM_INIT function. */ -tree gfor_fndecl_random_init; +tree gfor_fndecl_random_init; /* libgfortran, 1 image only. */ static void gfc_add_decl_to_parent_function (tree decl) @@ -3515,6 +3516,8 @@ gfc_build_intrinsic_function_decls (void) void_type_node, 3, gfc_logical4_type_node, gfc_logical4_type_node, gfc_int4_type_node); + // gfor_fndecl_caf_rand_init is defined in the lib-coarray section below= . + gfor_fndecl_sc_kind =3D gfc_build_library_function_decl_with_spec ( get_identifier (PREFIX("selected_char_kind")), ". . R ", gfc_int4_type_node, 2, gfc_charlen_type_node, pchar_type_node); @@ -4080,6 +4083,10 @@ gfc_build_builtin_function_decls (void) get_identifier (PREFIX("caf_is_present")), ". r . r ", integer_type_node, 3, pvoid_type_node, integer_type_node, pvoid_type_node); + + gfor_fndecl_caf_random_init =3D gfc_build_library_function_decl ( + get_identifier (PREFIX("caf_random_init")), + void_type_node, 2, logical_type_node, logical_type_node); } gfc_build_intrinsic_function_decls (); diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c index cceef8f34ac..3f38ec8de85 100644 =2D-- a/gcc/fortran/trans-intrinsic.c +++ b/gcc/fortran/trans-intrinsic.c @@ -3827,38 +3827,43 @@ conv_intrinsic_random_init (gfc_code *code) { stmtblock_t block; gfc_se se; - tree arg1, arg2, arg3, tmp; - tree logical4_type_node =3D gfc_get_logical_type (4); + tree arg1, arg2, tmp; + /* On none coarray =3D=3D lib compiles use LOGICAL(4) else regular LOGI= CAL. */ + tree used_bool_type_node =3D flag_coarray =3D=3D GFC_FCOARRAY_LIB + ? logical_type_node + : gfc_get_logical_type (4); /* Make the function call. */ gfc_init_block (&block); gfc_init_se (&se, NULL); - /* Convert REPEATABLE to a LOGICAL(4) entity. */ + /* Convert REPEATABLE to the desired LOGICAL entity. */ gfc_conv_expr (&se, code->ext.actual->expr); gfc_add_block_to_block (&block, &se.pre); - arg1 =3D fold_convert (logical4_type_node, gfc_evaluate_now (se.expr, &= block)); + arg1 =3D fold_convert (used_bool_type_node, gfc_evaluate_now (se.expr, = &block)); gfc_add_block_to_block (&block, &se.post); - /* Convert IMAGE_DISTINCT to a LOGICAL(4) entity. */ + /* Convert IMAGE_DISTINCT to the desired LOGICAL entity. */ gfc_conv_expr (&se, code->ext.actual->next->expr); gfc_add_block_to_block (&block, &se.pre); - arg2 =3D fold_convert (logical4_type_node, gfc_evaluate_now (se.expr, &= block)); + arg2 =3D fold_convert (used_bool_type_node, gfc_evaluate_now (se.expr, = &block)); gfc_add_block_to_block (&block, &se.post); - /* Create the hidden argument. For non-coarray codes and -fcoarray=3Ds= ingle, - simply set this to 0. For -fcoarray=3Dlib, generate a call to - THIS_IMAGE() without arguments. */ - arg3 =3D build_int_cst (gfc_get_int_type (4), 0); if (flag_coarray =3D=3D GFC_FCOARRAY_LIB) { - arg3 =3D build_call_expr_loc (input_location, gfor_fndecl_caf_this_= image, - 1, arg3); - se.expr =3D fold_convert (gfc_get_int_type (4), arg3); + tmp =3D build_call_expr_loc (input_location, gfor_fndecl_caf_random= _init, + 2, arg1, arg2); + } + else + { + /* The ABI for libgfortran needs to be maintained, so a hidden + argument must be include if code is compiled with -fcoarray=3Dsingle + or without the option. Set to 0. */ + tree arg3 =3D build_int_cst (gfc_get_int_type (4), 0); + tmp =3D build_call_expr_loc (input_location, gfor_fndecl_random_ini= t, + 3, arg1, arg2, arg3); } - tmp =3D build_call_expr_loc (input_location, gfor_fndecl_random_init, 3= , - arg1, arg2, arg3); gfc_add_expr_to_block (&block, tmp); return gfc_finish_block (&block); diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h index 8c6f82ff1b1..69d3fdcfdac 100644 =2D-- a/gcc/fortran/trans.h +++ b/gcc/fortran/trans.h @@ -969,6 +969,7 @@ extern GTY(()) tree gfor_fndecl_ieee_procedure_exit; /* RANDOM_INIT. */ extern GTY(()) tree gfor_fndecl_random_init; +extern GTY(()) tree gfor_fndecl_caf_random_init; /* True if node is an integer constant. */ #define INTEGER_CST_P(node) (TREE_CODE(node) =3D=3D INTEGER_CST) diff --git a/libgfortran/caf/libcaf.h b/libgfortran/caf/libcaf.h index 5abb753f6fd..c66d0379042 100644 =2D-- a/libgfortran/caf/libcaf.h +++ b/libgfortran/caf/libcaf.h @@ -261,4 +261,6 @@ void _gfortran_caf_stopped_images (gfc_descriptor_t *, int _gfortran_caf_is_present (caf_token_t, int, caf_reference_t *); +void _gfortran_caf_random_init (bool, bool); + #endif /* LIBCAF_H */ diff --git a/libgfortran/caf/single.c b/libgfortran/caf/single.c index a291c4452c9..fc8e3b3b94a 100644 =2D-- a/libgfortran/caf/single.c +++ b/libgfortran/caf/single.c @@ -3135,3 +3135,13 @@ _gfortran_caf_is_present (caf_token_t token, } return memptr !=3D NULL; } + +/* Reference the libraries implementation. */ +extern void _gfortran_random_init (int32_t, int32_t, int32_t); + +void _gfortran_caf_random_init (bool repeatable, bool image_distinct) +{ + /* In a single image implementation always forward to the gfortran + routine. */ + _gfortran_random_init (repeatable, image_distinct, 1); +} diff --git a/libgfortran/gfortran.map b/libgfortran/gfortran.map index f74436fd338..32579831a65 100644 =2D-- a/libgfortran/gfortran.map +++ b/libgfortran/gfortran.map @@ -1629,3 +1629,8 @@ GFORTRAN_10.2 { _gfortran_mfindloc1_c10; _gfortran_sfindloc1_c10; } GFORTRAN_10; + +GFORTRAN_12 { + global: + _gfortran_caf_random_init; +} GFORTRAN_10.2; diff --git a/libgfortran/intrinsics/random_init.f90 b/libgfortran/intrinsi= cs/random_init.f90 index e5b4087efd9..1200225e182 100644 =2D-- a/libgfortran/intrinsics/random_init.f90 +++ b/libgfortran/intrinsics/random_init.f90 @@ -1,94 +1,100 @@ ! Copyright (C) 2018-2021 Free Software Foundation, Inc. ! Contributed by Steven G. Kargl -! +! ! This file is part of the GNU Fortran runtime library (libgfortran). -! +! ! Libgfortran is free software; you can redistribute it and/or ! modify it under the terms of the GNU General Public ! License as published by the Free Software Foundation; either ! version 3 of the License, or (at your option) any later version. -! +! ! Libgfortran is distributed in the hope that it will be useful, ! but WITHOUT ANY WARRANTY; without even the implied warranty of ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ! GNU General Public License for more details. -! +! ! Under Section 7 of GPL version 3, you are granted additional ! permissions described in the GCC Runtime Library Exception, version ! 3.1, as published by the Free Software Foundation. -! +! ! You should have received a copy of the GNU General Public License and ! a copy of the GCC Runtime Library Exception along with this program; ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ! . ! -! ! WARNING: This file should never be compiled with an option that change= s ! default logical kind from 4 to some other value or changes default inte= ger -! kind from from 4 to some other value. -! -! -! There are four combinations of repeatable and image_distinct. If a pro= gram -! is compiled without the -fcoarray=3D option or with -fcoarray=3Dsingle,= then -! execution of the compiled executable does not use image_distinct as it = is -! irrelevant (although required). The behavior is as follows: -! -! call random_init(.true., .true.) +! kind from 4 to some other value. ! -! The sequence of random numbers is repeatable within an instance of prog= ram -! execution. That is, calls to random_init(.true., .true.) during the -! execution will reset the sequence of RN to the same sequence. If the -! program is compiled with -fcoarray=3Dlib and multiple images are instan= tiated, -! then each image accesses a repeatable distinct sequence of random numbe= rs. -! There are no guarantees that multiple execution of the program will acc= ess -! the same sequence. +! There are four combinations of repeatable and image_distinct. The +! language below is from the F2018 standard (actually, J3/18-007r1). ! -! call random_init(.false., .false.) -! call random_init(.false., .true.) +! This routine is only used for non-coarray programs or with programs +! compiled with -fcoarray=3Dsingle. Use of -fcoarray=3Dlib or -fcoarray= =3Dshared +! requires different routines due to the need for communication between +! images under case(iv). ! -! The sequence of random numbers is determined from process-dependent see= ds. -! On each execution of the executable, different seeds will be used. For -! -fcoarray=3Dlib and multiple instantiated images, each image will use -! process-dependent seeds. In other words, the two calls have identical -! behavior. +! Technically, neither image_distinct nor image_num are now needed. The +! interface to _gfortran_random_init() is maintained for libgfortran ABI. +! Note, the Fortran standard requires the image_distinct argument, so +! it will always have a valid value, and the frontend generates an value +! of 0 for image_num. ! -! call random_init(.true., .false.) -! -! For a program compiled without the -fcoarray=3D option or with -! -fcoarray=3Dsingle, a single image is instantiated when the executable = is -! run. If the executable causes multiple images to be instantiated, then -! image_distinct=3D.false. in one image cannot affect the sequence of ran= dom -! numbers in another image. As gfortran gives each image its own indepen= dent -! PRNG, this condition is automatically satisfied. -! -impure subroutine _gfortran_random_init(repeatable, image_distinct, hidde= n) +impure subroutine _gfortran_random_init(repeatable, image_distinct, image= _num) implicit none logical, value, intent(in) :: repeatable logical, value, intent(in) :: image_distinct - integer, value, intent(in) :: hidden + integer, value, intent(in) :: image_num logical, save :: once =3D .true. - integer :: nseed + integer :: nseed, lcg_seed integer, save, allocatable :: seed(:) - if (once) then - once =3D .false. - call random_seed(size=3Dnseed) - allocate(seed(nseed)) - call random_seed(get=3Dseed) + if (repeatable) then + if (once) then + once =3D .false. + call random_seed(size=3Dnseed) + allocate(seed(nseed)) + lcg_seed =3D 57911963 + call _gfortran_lcg(seed) + end if + call random_seed(put=3Dseed) + else + call random_seed() ! - ! To guarantee that seed is distinct on multiple images, add the hi= dden - ! argument (which is the image index). + ! This cannot happen; but, prevent gfortran complaining about + ! unused variables. ! - if (image_distinct) seed =3D seed + hidden + if (image_num > 2) then + block + use iso_fortran_env, only : error_unit + write(error_unit, '(A)') 'whoops: random_init(.false., .false= .)' + if (image_distinct) error stop image_num + 1 + error stop image_num + end block + end if end if - if (repeatable) then - call random_seed(put=3Dseed); - else - call random_seed(); - end if + contains + ! + ! SK Park and KW Miller, ``Random number generators: good ones are = hard + ! to find,'' Comm. ACM, 31(10), 1192--1201, (1988). + ! + ! Implementation of a prime modulus multiplicative linear congruent= ial + ! generator, which avoids overflow and provides the full period. + ! + impure elemental subroutine _gfortran_lcg(i) + implicit none + integer, intent(out) :: i + integer, parameter :: a =3D 16807 ! Multiplier + integer, parameter :: m =3D huge(a) ! Modulus + integer, parameter :: q =3D 127773 ! Quotient to avoid overfl= ow + integer, parameter :: r =3D 2836 ! Remainder to avoid overf= low + lcg_seed =3D a * mod(lcg_seed, q) - r * (lcg_seed / q) + if (lcg_seed <=3D 0) lcg_seed =3D lcg_seed + m + i =3D lcg_seed + end subroutine _gfortran_lcg end subroutine _gfortran_random_init --MP_/YbQAwlmXfyp2Nx.juMs.xSW--