From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mout.gmx.net (mout.gmx.net [212.227.17.21]) by sourceware.org (Postfix) with ESMTPS id 94F24385742D; Fri, 21 May 2021 08:09:22 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.3.2 sourceware.org 94F24385742D X-UI-Sender-Class: 01bb95c1-4bf8-414a-932a-4f6e2808ef9c Received: from vepi2 ([79.194.169.29]) by mail.gmx.net (mrgmx105 [212.227.17.168]) with ESMTPSA (Nemesis) id 1Mw9UK-1lRNP31Epw-00s794; Fri, 21 May 2021 10:09:05 +0200 Date: Fri, 21 May 2021 10:09:02 +0200 From: Andre Vehreschild To: Steve Kargl Cc: GCC-Fortran-ML , GCC-Patches-ML Subject: Re: [Ping^2, Patch, Fortran] PR98301 Re: RANDOM_INIT() and coarray Fortran Message-ID: <20210521100902.78d4aa4d@vepi2> In-Reply-To: <20210503152036.GA29178@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> <20210426123636.7eb24c37@vepi2> <20210503112110.7580eb41@vepi2> <20210503152036.GA29178@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_/f7i3R9VM3ZxzrUFdUhHl1V5" X-Provags-ID: V03:K1:/o0JKe/XFPloRlXpl4MWlMpRo/jgHpReHFhoznsYbn8EiLmheSZ Qr1v2j0kMEpYeUWGxnYGCxKuUtzyugn7LlryEiBO44kh6BdMcMxqtTBN+bmid+vnXhRCmD9 dkDdOMCgRRfLxEfEiyBItMpqnPuSw8FPOFzIqL5nwNl3PdM1iO868092L3A9HLpI7ycH5EI 9TCXcmHf0ePgsdFYToZaw== X-UI-Out-Filterresults: notjunk:1;V03:K0:ZYHUXLbnuxU=:/9sxJ3dDMCx0uFvIgIC37X 4lz6765r9pgDr5tKy68giTEzgevqkOrHOj81kxpDnPzdTYu8kuSBMhSmVqTxmRQMnrf1tdW83 k6JhY1OD5bty6ZGwXG99Xl+Z00kXV2lGv1DcI9hBusJfZuQhPwVtcjxa9Tn+Y/zBnMl5l4baP 6KnCNo6StTcQ8/MaBzqP+vEIZwvWSTtO5nw6+0wuoG+61sBjJiZgSlIEtTmVz5IwopQAzMxjO pTz/wfSWmBkC/DG64Drc4vsd265vSLUZr5/y2tygzVfIDg1s92OxYWxtU8kxFpWUSNLnFr1Dq Y63ZqagK7SwbTYqGc9WX9hsf8kEdy89/vZHWUzvdi2m8ySgbqfLO6AWtEbn5pGt/geaTpEfLV CoVkoIHKocLgIHChnY+9rdOC5+n3WeCMUavw98cEf8kBr93qF9FbKIjkHuHUQxWr4tgm7nSGh Qsb1DDpTWZdQ8I6hANtV0Ghu94VZjHQKXbHfU3SWLIoKfOUEDJGL4K4eWRkqEGB6SYmjlOm+K wZS9kKkL/36oYM2sx6DhPkWczBhQCjDWQ0xtQezEkPr5Y3ZdBP0e6ictsa2weoRdMUU8QH0b8 vzHjt75kv7haFodwopOeFSDzpBN5R5RE9WnebU7v1vnHRXdNpE4PfnxnR66jSOxoURQlqDO7T x/Ys2aLgheMv+zpLg3tSV4bpYENAjbN2onAV6bbyR8fxOJXkRigBOtwznO4ojpMRpyzNncIHg zXrtLq6145k126NoSG/5AJYy3V8mSq8vINomS9loOmpjfINMb95PKLLYdB9ctP3+wO5qKmG8j egkKkK+dGYm8DK8gMSSuLcRKRYUZvfsvjFVAOWv8DG0EfIssBthMjUVUmOZ+Y+aA5HVf+LS9V /aFS+Z3OwMEInzws3IO4+jhpxHJBtalDHx+tCFMjEtzYeZnBhb1RrcelRczzph1j2+Obp1Em2 kZACSkkjmBDieV8/jhDcBCXNKqJ+NIqWcvL2dXZ2DZ7S6JSQwztzpkAR8sPMIn38s6mbA7k3T VjJBWeUP4/8nuiODBxNys+jDDdgb5RFcFw59WoVqMDndgdcWYtE+DfyPg6lj9iV1wpEPBb/H3 Ra3QL0+iS4kOECx9gvn97yDMKa5BHsEMEsNvsTpiQsQ6tErjhKa8tFDGUV4jpL2TsYK8TVzfu JRfKdCkBzllkqSCIiit0ct43BbQlI6cQmtib2hI1AU8+vMIYnmiBCHFoq7ZEFI4BSzXLs= X-Spam-Status: No, score=-10.2 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: Fri, 21 May 2021 08:09:25 -0000 --MP_/f7i3R9VM3ZxzrUFdUhHl1V5 Content-Type: text/plain; charset=US-ASCII Content-Transfer-Encoding: quoted-printable Content-Disposition: inline Ping, ping! Please find attached a rebased version of the patch for the RANDOM_INIT is= sue with coarray Fortran. Nothing changed to the previous version, just rebase= d to current master. Regtested fine on x86_64-linux/f33. Ok for trunk? - Andre On Mon, 3 May 2021 08:20:36 -0700 Steve Kargl wrote: > On Mon, May 03, 2021 at 11:21:10AM +0200, Andre Vehreschild wrote: > > Ping! > > > > Ok for trunk? > > > > I have looked at other patches, but none was patching any location I h= ave > > worked on previously. Therefore I can't return the favor of reviewing = any > > currently open patches and have to ask for volunteers here. > > > > - Andre > > > > I doubt I'm allowed to approve a patch, where I wrote a portion > of it. However, if no one else steps forward in the next day > or two, then I think you should commit. > =2D- Andre Vehreschild * Email: vehre ad gmx dot de --MP_/f7i3R9VM3ZxzrUFdUhHl1V5 Content-Type: text/x-log Content-Transfer-Encoding: 7bit Content-Disposition: attachment; filename=pr98301_v2.log Steve Kargl PR fortran/98301 - random_init() is broken Correct implementation of random_init() when -fcoarray=lib 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. --MP_/f7i3R9VM3ZxzrUFdUhHl1V5 Content-Type: text/x-patch Content-Transfer-Encoding: quoted-printable Content-Disposition: attachment; filename=pr98301_v2.patch diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index 406b4aeb1d4..c32bd05bb1b 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) @@ -3516,6 +3517,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); @@ -4081,6 +4084,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 4d7451479d3..db9248c0043 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_/f7i3R9VM3ZxzrUFdUhHl1V5--