@@ -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 = 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 = 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 ();
@@ -3837,38 +3837,43 @@ 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);
+ }
+ 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);
@@ -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) == INTEGER_CST)
@@ -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 */
@@ -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);
+}
@@ -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;
@@ -1,94 +1,100 @@
! Copyright (C) 2018-2021 Free Software Foundation, Inc.
! Contributed by Steven G. Kargl <kargl@gcc.gnu.org>
-!
+!
! 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
! <http://www.gnu.org/licenses/>.
!
-!
! 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:
-!
-! call random_init(.true., .true.)
+! kind from 4 to some other value.
!
-! 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.
+! 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=single. Use of -fcoarray=lib or -fcoarray=shared
+! requires different routines due to the need for communication between
+! images under case(iv).
!
-! 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.
+! 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= 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