From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mout.gmx.net (mout.gmx.net [212.227.17.20]) by sourceware.org (Postfix) with ESMTPS id 4B10C3958C18 for ; Sat, 24 Apr 2021 10:50:10 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.3.2 sourceware.org 4B10C3958C18 X-UI-Sender-Class: 01bb95c1-4bf8-414a-932a-4f6e2808ef9c Received: from vepi2 ([79.194.169.29]) by mail.gmx.net (mrgmx104 [212.227.17.168]) with ESMTPSA (Nemesis) id 1MrQJ5-1lEKmh1pax-00oX06; Sat, 24 Apr 2021 12:49:48 +0200 Date: Sat, 24 Apr 2021 12:49:45 +0200 From: Andre Vehreschild To: Steve Kargl Cc: GCC-Fortran-ML , Damian Rouson , Andre Vehreschild Subject: Re: [Patch, Fortran, Update] PR98301 Re: RANDOM_INIT() and coarray Fortran Message-ID: <20210424124945.46b1da51@vepi2> In-Reply-To: <20210423171817.GA75072@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> 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_/T3rMm1mn+xltF9Vlu_PHFR0" X-Provags-ID: V03:K1:SF9MgOX6sRulpM4ppxoOzBmpgUd6svkSbPTAKamwsuvY04xZ/3f jiC9y2bdubu2f556kGXQ4+aG1S879nY5Aw6qb4r40A2d1mYpnkAzMSp2d88MmxIg+yaoDoU +EP3SIDGz5MJp70dygrjuBOB/M6vtroxQN6FnJfQQ3jTHbL8Dg08UDapAZXp9fQvoJ3Ejbi +kdmC+x0KFVMdrSxQrbhA== X-UI-Out-Filterresults: notjunk:1;V03:K0:ry4yLkv0+90=:p4lvHQE/Md+pw3htQXlakY DHP2Q+84vGqDmZFb3wBK+uF6WNmgrq4v8/GRPsSt9IFlWYsSwqY5qBe/VW3PESE4bVn+rSSHB /cykTTtGbm0I+asgy2fAQGcTh3mawb74WHJi9Vh0KQbjo7nCyZIjCBme0ggTL9ye0PilXE+dC f5PF2jB/6cLi9grPBmwVUTQS2NRsr1Hu9RfXZ7DJf+CkcTkZul0t7w0umBoS2/bG0xZCw6Rdd FWgLnF3faRJBR819LhHh2l81CMKiZ5yTCMIy4z9bxQQx+fJ62WPWhqL4fw1kU9VIk8/wiuCao OK5G7dvea5hmjjomgEh0NRH1GDop+LA3r+EZFhudeGgNZh0KjFOTQdIqAjVKmPsN7mWx/49Cb dfRTMjgeW6vls/xSF2ImYcOar/hPfsD77cicpUMmfGeF6WPWdA+NHrx15MnOkpCRV5v8PbxuN 7FvNTeMlLvzqpd7l7klKWd7F8/mAscofQFwkxSzS7TuU74DrH+rcbypaEYmsh92rNOGXY6KCr izzXsbZ6INOHph9Je2ehBUVcT0Rt65Pu869lUR45LAdaw6/NFj5ix4+VBQh7smVaeJZHhykMo xJqypYc1dkkIKV2K1lF5c1JGUuYi4Hgy2S32EJHDbkIST0O767kYwu85GGcOl2s+blSV/CQv1 gRV8ptxL0xJZpdcItjBg1YG30tip2hYi/MCvgNXquyz1g339ANHREoO5FLrz+iDoHdm1YZ2eJ yz4dB8lLsRJqvYpKGEklWfImonTvekMqR/T4BJpsODU8wFlPFI2EJFw8ZU9KElv0CmJVPhSOi ouye3B4Gq7bTcuhHs/J7JK+GImNzA8DNotUU5hb8eldDK/6zj7JZH6wLzWyrKaMi/1NP2zOjO 1MISvYWcrH+DmBTZyWInHCwqKOSowPBMl05AnG9UYIdUv+gi5G/F/E298yrz/PPKiVf3YOcPv 0DCkkgdtxQKN2gPd9n6O+ossNZXFbzmom2HBhzqBqr2r26NoymB1moO7guiN/6T/4usn9Enyz 0VVpu1Gl1WOHWeRY0zJRHTmP8CO2QHBrq1/oUiUdcJ5d4qJsVbzVQArmyouqv1CIA5/0hMEK6 9hBfRubSAaPwn2GrVAx7TGgoe3IC5pykSVGV6dD3dBdMmUkzjaifMINy8M6fTnjT5jnP+CCok 6TkFthEcT5yPQYHRkPKIjevy7/3e3EmZPNqybCiOx3rC51SdG7lluc9M4uh8hqYshA9+8= X-Spam-Status: No, score=-10.8 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: Sat, 24 Apr 2021 10:50:16 -0000 --MP_/T3rMm1mn+xltF9Vlu_PHFR0 Content-Type: text/plain; charset=US-ASCII Content-Transfer-Encoding: quoted-printable Content-Disposition: inline Hi Steve, hi all, thank you for pointing that out, Steve. When I started the work, I told myself, that I have to remember to add your patch to the submit. Well, tha= t did not last for more than eight hours and I had forgotten. So here is now the combination of Steve's and my patch (attached). Bootstrapped and regtested ok on x86_64/f33. @Steve: Is this your correct mail address for the changelog or do you pref= er a different one? Regards, Andre Changelog: 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/98301 * 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 Fri, 23 Apr 2021 10:18:17 -0700 Steve Kargl wrote: > Andre, > > Thanks for taking care of OpenCoarray portion of RANDOM_INIT. > My last non-coarray aware patch is attached to the PR in bugzilla. > Since the change over to git, I no longer commit to the source tree. > I suggest combining your patch with my patch if you intend to > commit; otherwise, attach your patch to the PR and sit patiently > until someone can do the combined commit. > =2D- Andre Vehreschild * Email: vehre ad gmx dot de --MP_/T3rMm1mn+xltF9Vlu_PHFR0 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..de0e8fb0314 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,8 @@ 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. */ +tree gfor_fndecl_cas_random_init; /* Shared memory coarray. */ static void gfc_add_decl_to_parent_function (tree decl) @@ -3515,6 +3517,22 @@ 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= . + +/* FIXME: This is a temporary workaround until someone that uses coarray + Fortran and random_init() can implement the OpenCoarray and/or the + shared memory routines. Both require communication between images, so + these routines cannot live in libgfortran. */ +#if 1 + gfor_fndecl_cas_random_init =3D gfc_build_library_function_decl ( + get_identifier (PREFIX("random_init_foobar")), + void_type_node, 2, gfc_logical4_type_node, gfc_logical4_type_node); +#else + gfor_fndecl_cas_random_init =3D gfc_build_library_function_decl ( + get_identifier (PREFIX("cas_random_init")), + void_type_node, 2, gfc_logical4_type_node, gfc_logical4_type_node); +#endif + 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 +4098,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..8319e94b893 100644 =2D-- a/gcc/fortran/trans-intrinsic.c +++ b/gcc/fortran/trans-intrinsic.c @@ -3827,38 +3827,50 @@ 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); + } +#if 0 + else if (flag_coarray =3D=3D GFC_FCOARRAY_SHARED) + { + tmp =3D build_call_expr_loc (input_location, gfor_fndecl_cas_random= _init, + 2, arg1, arg2); + } +#endif + 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..a82b5adec94 100644 =2D-- a/gcc/fortran/trans.h +++ b/gcc/fortran/trans.h @@ -969,6 +969,8 @@ 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; +extern GTY(()) tree gfor_fndecl_cas_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..ad19409bfb2 100644 =2D-- a/libgfortran/gfortran.map +++ b/libgfortran/gfortran.map @@ -1629,3 +1629,9 @@ GFORTRAN_10.2 { _gfortran_mfindloc1_c10; _gfortran_sfindloc1_c10; } GFORTRAN_10; + +GFORTRAN_12 { + global: + _gfortran_caf_random_init; + _gfortran_random_init_foobar; +} GFORTRAN_10.2; diff --git a/libgfortran/intrinsics/random_init.f90 b/libgfortran/intrinsi= cs/random_init.f90 index e5b4087efd9..233a1ca073a 100644 =2D-- a/libgfortran/intrinsics/random_init.f90 +++ b/libgfortran/intrinsics/random_init.f90 @@ -1,94 +1,125 @@ ! 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: +! kind from 4 to some other value. ! -! call random_init(.true., .true.) +! There are four combinations of repeatable and image_distinct. The +! language below is from the F2018 standard (actually, J3/18-007r1). ! -! 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. +! 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). ! -! call random_init(.false., .false.) -! call random_init(.false., .true.) +! 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. ! -! 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. -! -! 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 +! +! This is a temporary stub implementation until random_init is +! implemented for -fcoarray=3Dshared. +! +subroutine _gfortran_random_init_foobar(repeatable, image_distinct) + + use iso_fortran_env, only : error_unit + + implicit none + + logical, value, intent(in) :: repeatable + logical, value, intent(in) :: image_distinct + + block + write(error_unit, '(A)') & + & 'random_init: not yet supported with coarray Fortran' + error stop 1 + end block + + if (.false. .and. (repeatable .and. image_distinct)) then + write(error_unit, '(A)') 'random_init: Unreachable' + error stop 1 + end if + +end subroutine _gfortran_random_init_foobar --MP_/T3rMm1mn+xltF9Vlu_PHFR0--