diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index cc9d85543ca..de0e8fb0314 100644 --- 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 = 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 = 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 = 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 = 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 --- 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 = gfc_get_logical_type (4); + tree arg1, arg2, tmp; + /* On none coarray == lib compiles use LOGICAL(4) else regular LOGICAL. */ + tree used_bool_type_node = flag_coarray == 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 = fold_convert (logical4_type_node, gfc_evaluate_now (se.expr, &block)); + arg1 = 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 = fold_convert (logical4_type_node, gfc_evaluate_now (se.expr, &block)); + arg2 = 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=single, - simply set this to 0. For -fcoarray=lib, generate a call to - THIS_IMAGE() without arguments. */ - arg3 = build_int_cst (gfc_get_int_type (4), 0); if (flag_coarray == GFC_FCOARRAY_LIB) { - arg3 = build_call_expr_loc (input_location, gfor_fndecl_caf_this_image, - 1, arg3); - se.expr = fold_convert (gfc_get_int_type (4), arg3); + tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_random_init, + 2, arg1, arg2); + } +#if 0 + else if (flag_coarray == GFC_FCOARRAY_SHARED) + { + tmp = 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=single + or without the option. Set to 0. */ + tree arg3 = build_int_cst (gfc_get_int_type (4), 0); + tmp = build_call_expr_loc (input_location, gfor_fndecl_random_init, + 3, arg1, arg2, arg3); } - tmp = 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 --- 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) == INTEGER_CST) diff --git a/libgfortran/caf/libcaf.h b/libgfortran/caf/libcaf.h index 5abb753f6fd..c66d0379042 100644 --- 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 --- a/libgfortran/caf/single.c +++ b/libgfortran/caf/single.c @@ -3135,3 +3135,13 @@ _gfortran_caf_is_present (caf_token_t token, } return memptr != 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 --- 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/intrinsics/random_init.f90 index e5b4087efd9..233a1ca073a 100644 --- 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 changes ! default logical kind from 4 to some other value or changes default integer -! kind from from 4 to some other value. -! -! -! There are four combinations of repeatable and image_distinct. If a program -! is compiled without the -fcoarray= option or with -fcoarray=single, 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 program -! 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=lib and multiple images are instantiated, -! then each image accesses a repeatable distinct sequence of random numbers. -! There are no guarantees that multiple execution of the program will access -! the same sequence. +! This routine is only used for non-coarray programs or with programs +! compiled with -fcoarray=single. Use of -fcoarray=lib or -fcoarray=shared +! 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 seeds. -! On each execution of the executable, different seeds will be used. For -! -fcoarray=lib 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= option or with -! -fcoarray=single, a single image is instantiated when the executable is -! run. If the executable causes multiple images to be instantiated, then -! image_distinct=.false. in one image cannot affect the sequence of random -! numbers in another image. As gfortran gives each image its own independent -! PRNG, this condition is automatically satisfied. -! -impure subroutine _gfortran_random_init(repeatable, image_distinct, hidden) +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 = .true. - integer :: nseed + integer :: nseed, lcg_seed integer, save, allocatable :: seed(:) - if (once) then - once = .false. - call random_seed(size=nseed) - allocate(seed(nseed)) - call random_seed(get=seed) + if (repeatable) then + if (once) then + once = .false. + call random_seed(size=nseed) + allocate(seed(nseed)) + lcg_seed = 57911963 + call _gfortran_lcg(seed) + end if + call random_seed(put=seed) + else + call random_seed() ! - ! To guarantee that seed is distinct on multiple images, add the hidden - ! argument (which is the image index). + ! This cannot happen; but, prevent gfortran complaining about + ! unused variables. ! - if (image_distinct) seed = 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=seed); - 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 congruential + ! generator, which avoids overflow and provides the full period. + ! + impure elemental subroutine _gfortran_lcg(i) + implicit none + integer, intent(out) :: i + integer, parameter :: a = 16807 ! Multiplier + integer, parameter :: m = huge(a) ! Modulus + integer, parameter :: q = 127773 ! Quotient to avoid overflow + integer, parameter :: r = 2836 ! Remainder to avoid overflow + lcg_seed = a * mod(lcg_seed, q) - r * (lcg_seed / q) + if (lcg_seed <= 0) lcg_seed = lcg_seed + m + i = lcg_seed + end subroutine _gfortran_lcg end subroutine _gfortran_random_init +! +! This is a temporary stub implementation until random_init is +! implemented for -fcoarray=shared. +! +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