From ddd3e26e42b8d55989f9964c6ec6ee50b30b1802 Mon Sep 17 00:00:00 2001
From: "Steven G. Kargl" <kargl@gcc.gnu.org>
Date: Fri, 1 Jun 2018 17:05:02 +0000
Subject: re PR fortran/63570 ([F2018] Implement 13.7.137 RANDOM INIT
(REPEATABLE, IMAGE DISTINCT))
2018-06-01 Steven G. Kargl <kargl@gcc.gnu.org>
PR fortran/63570
* check.c (gfc_check_random_init): New function. Check arguments of
RANDOM_INIT.
* gfortran.h (GFC_ISYM_RANDOM_INIT): New enum token.
* intrinsic.c (add_subroutines): Add RANDOM_INIT to list of
subroutines.
(gfc_check_intrinsic_standard): Introduce Fortran 2018 check.
* intrinsic.h: Add prototypes for gfc_check_random_init and
gfc_resolve_random_init
* intrinsic.texi: Document new intrinsic subprogram.
* iresolve.c (gfc_resolve_random_init): Resolve routine name.
* trans-decl.c: Declare gfor_fndecl_random_init
* trans-intrinsic.c (conv_intrinsic_random_init): New function.
Translate call to RANDOM_INIT.
(gfc_conv_intrinsic_subroutine): Call it.
* trans.h: Declare gfor_fndecl_random_init
2018-06-01 Steven G. Kargl <kargl@gcc.gnu.org>
PR fortran/63570
* gfortran.dg/random_init_1.f90: New test.
* gfortran.dg/random_init_2.f90: New test.
* gfortran.dg/random_init_3.f90: New test.
* gfortran.dg/random_init_4.f90: New test.
* gfortran.dg/random_init_5.f90: New test.
* gfortran.dg/random_init_6.f90: New test.
2018-06-01 Steven G. Kargl <kargl@gcc.gnu.org>
PR fortran/63570
* libgfortran/Makefile.am: Add random_init.f90 to build.
* libgfortran/Makefile.in: Regenerated.
* libgfortran/gfortran.map: Expose symbol for _gfortran_random_init.
* libgfortran/intrinsics/random_init.f90: Implementation.
From-SVN: r261075
---
gcc/fortran/ChangeLog | 19 ++++++++++++++
gcc/fortran/check.c | 21 +++++++++++++++
gcc/fortran/gfortran.h | 1 +
gcc/fortran/intrinsic.c | 6 +++++
gcc/fortran/intrinsic.h | 2 ++
gcc/fortran/intrinsic.texi | 59 +++++++++++++++++++++++++++++++++++++++++--
gcc/fortran/iresolve.c | 11 ++++++++
gcc/fortran/trans-decl.c | 7 +++++
gcc/fortran/trans-intrinsic.c | 50 ++++++++++++++++++++++++++++++++++++
gcc/fortran/trans.h | 2 ++
10 files changed, 176 insertions(+), 2 deletions(-)
(limited to 'gcc/fortran')
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 95914ae..272a94e 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,22 @@
+2018-06-01 Steven G. Kargl <kargl@gcc.gnu.org>
+
+ PR fortran/63570
+ * check.c (gfc_check_random_init): New function. Check arguments of
+ RANDOM_INIT.
+ * gfortran.h (GFC_ISYM_RANDOM_INIT): New enum token.
+ * intrinsic.c (add_subroutines): Add RANDOM_INIT to list of
+ subroutines.
+ (gfc_check_intrinsic_standard): Introduce Fortran 2018 check.
+ * intrinsic.h: Add prototypes for gfc_check_random_init and
+ gfc_resolve_random_init
+ * intrinsic.texi: Document new intrinsic subprogram.
+ * iresolve.c (gfc_resolve_random_init): Resolve routine name.
+ * trans-decl.c: Declare gfor_fndecl_random_init
+ * trans-intrinsic.c (conv_intrinsic_random_init): New function.
+ Translate call to RANDOM_INIT.
+ (gfc_conv_intrinsic_subroutine): Call it.
+ * trans.h: Declare gfor_fndecl_random_init
+
2018-05-27 Steven G. Kargl <kargl@gcc.gnu.org>
* decl.c (match_data_constant): Fortran 2018 allows pointer
diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c
index 8d41fcd..30214fe 100644
--- a/gcc/fortran/check.c
+++ b/gcc/fortran/check.c
@@ -5786,6 +5786,27 @@ gfc_check_mvbits (gfc_expr *from, gfc_expr *frompos, gfc_expr *len,
}
+/* Check the arguments for RANDOM_INIT. */
+
+bool
+gfc_check_random_init (gfc_expr *repeatable, gfc_expr *image_distinct)
+{
+ if (!type_check (repeatable, 0, BT_LOGICAL))
+ return false;
+
+ if (!scalar_check (repeatable, 0))
+ return false;
+
+ if (!type_check (image_distinct, 1, BT_LOGICAL))
+ return false;
+
+ if (!scalar_check (image_distinct, 1))
+ return false;
+
+ return true;
+}
+
+
bool
gfc_check_random_number (gfc_expr *harvest)
{
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 4c4e7af..b7eaa0e 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -553,6 +553,7 @@ enum gfc_isym_id
GFC_ISYM_PRODUCT,
GFC_ISYM_RADIX,
GFC_ISYM_RAND,
+ GFC_ISYM_RANDOM_INIT,
GFC_ISYM_RANDOM_NUMBER,
GFC_ISYM_RANDOM_SEED,
GFC_ISYM_RANGE,
diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c
index 8dd135f..6096686 100644
--- a/gcc/fortran/intrinsic.c
+++ b/gcc/fortran/intrinsic.c
@@ -3568,6 +3568,12 @@ add_subroutines (void)
make_alias ("kmvbits", GFC_STD_GNU);
}
+ add_sym_2s ("random_init", GFC_ISYM_RANDOM_INIT, CLASS_IMPURE,
+ BT_UNKNOWN, 0, GFC_STD_F2018,
+ gfc_check_random_init, NULL, gfc_resolve_random_init,
+ "repeatable", BT_LOGICAL, dl, REQUIRED, INTENT_IN,
+ "image_distinct", BT_LOGICAL, dl, REQUIRED, INTENT_IN);
+
add_sym_1s ("random_number", GFC_ISYM_RANDOM_NUMBER, CLASS_IMPURE,
BT_UNKNOWN, 0, GFC_STD_F95,
gfc_check_random_number, NULL, gfc_resolve_random_number,
diff --git a/gcc/fortran/intrinsic.h b/gcc/fortran/intrinsic.h
index a483bfa..7a957d3 100644
--- a/gcc/fortran/intrinsic.h
+++ b/gcc/fortran/intrinsic.h
@@ -205,6 +205,7 @@ bool gfc_check_getlog (gfc_expr *);
bool gfc_check_move_alloc (gfc_expr *, gfc_expr *);
bool gfc_check_mvbits (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *,
gfc_expr *);
+bool gfc_check_random_init (gfc_expr *, gfc_expr *);
bool gfc_check_random_number (gfc_expr *);
bool gfc_check_random_seed (gfc_expr *, gfc_expr *, gfc_expr *);
bool gfc_check_dtime_etime_sub (gfc_expr *, gfc_expr *);
@@ -653,6 +654,7 @@ void gfc_resolve_lstat_sub (gfc_code *);
void gfc_resolve_ltime (gfc_code *);
void gfc_resolve_mvbits (gfc_code *);
void gfc_resolve_perror (gfc_code *);
+void gfc_resolve_random_init (gfc_code *);
void gfc_resolve_random_number (gfc_code *);
void gfc_resolve_random_seed (gfc_code *);
void gfc_resolve_rename_sub (gfc_code *);
diff --git a/gcc/fortran/intrinsic.texi b/gcc/fortran/intrinsic.texi
index adea02a..ca006c9 100644
--- a/gcc/fortran/intrinsic.texi
+++ b/gcc/fortran/intrinsic.texi
@@ -262,6 +262,7 @@ Some basic guidelines for editing this document:
* @code{RADIX}: RADIX, Base of a data model
* @code{RAN}: RAN, Real pseudo-random number
* @code{RAND}: RAND, Real pseudo-random number
+* @code{RANDOM_INIT}: RANDOM_INIT, Initialize pseudo-random number generator
* @code{RANDOM_NUMBER}: RANDOM_NUMBER, Pseudo-random number
* @code{RANDOM_SEED}: RANDOM_SEED, Initialize a pseudo-random number sequence
* @code{RANGE}: RANGE, Decimal exponent range
@@ -11598,6 +11599,60 @@ end program test_rand
@end table
+@node RANDOM_INIT
+@section @code{RANDOM_INIT} --- Initialize a pseudo-random number generator
+@fnindex RANDOM_INIT
+@cindex random number generation, initialization
+
+@table @asis
+@item @emph{Description}:
+Initializes the state of the pseudorandom number generator used by
+@code{RANDOM_NUMBER}.
+
+@item @emph{Standard}:
+Fortran 2018
+
+@item @emph{Class}:
+Subroutine
+
+@item @emph{Syntax}:
+@code{CALL RANDOM_INIT(REPEATABLE, IMAGE_DISTINCT)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .20 .75
+@item @var{REPEATABLE} @tab Shall be a scalar with a @code{LOGICAL} type,
+and it is @code{INTENT(IN)}. If it is @code{.true.}, the seed is set to
+a processor-dependent value that is the same each time @code{RANDOM_INIT}
+is called from the same image. The term ``same image'' means a single
+instance of program execution. The sequence of random numbers is different
+for repeated execution of the program. If it is @code{.false.}, the seed
+is set to a processor-dependent value.
+@item @var{IMAGE_DISTINCT} @tab Shall be a scalar with a
+@code{LOGICAL} type, and it is @code{INTENT(IN)}. If it is @code{.true.},
+the seed is set to a processor-dependent value that is distinct from th
+seed set by a call to @code{RANDOM_INIT} in another image. If it is
+@code{.false.}, the seed is set value that does depend which image called
+@code{RANDOM_INIT}.
+@end multitable
+
+@item @emph{Example}:
+@smallexample
+program test_random_seed
+ implicit none
+ real x(3), y(3)
+ call random_init(.true., .true.)
+ call random_number(x)
+ call random_init(.true., .true.)
+ call random_number(y)
+ ! x and y are the same sequence
+ if (any(x /= y)) call abort
+end program test_random_seed
+@end smallexample
+
+@item @emph{See also}:
+@ref{RANDOM_NUMBER}, @ref{RANDOM_SEED}
+@end table
+
@node RANDOM_NUMBER
@section @code{RANDOM_NUMBER} --- Pseudo-random number
@@ -11643,7 +11698,7 @@ end program
@end smallexample
@item @emph{See also}:
-@ref{RANDOM_SEED}
+@ref{RANDOM_SEED}, @ref{RANDOM_INIT}
@end table
@@ -11713,7 +11768,7 @@ end program test_random_seed
@end smallexample
@item @emph{See also}:
-@ref{RANDOM_NUMBER}
+@ref{RANDOM_NUMBER}, @ref{RANDOM_INIT}
@end table
diff --git a/gcc/fortran/iresolve.c b/gcc/fortran/iresolve.c
index f15b8f2..2eb8f7c 100644
--- a/gcc/fortran/iresolve.c
+++ b/gcc/fortran/iresolve.c
@@ -3404,6 +3404,17 @@ gfc_resolve_mvbits (gfc_code *c)
}
+/* Set up the call to RANDOM_INIT. */
+
+void
+gfc_resolve_random_init (gfc_code *c)
+{
+ const char *name;
+ name = gfc_get_string (PREFIX ("random_init"));
+ c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
+}
+
+
void
gfc_resolve_random_number (gfc_code *c)
{
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index 6c4a221..cd23c2d 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -229,6 +229,8 @@ tree gfor_fndecl_dgemm;
tree gfor_fndecl_cgemm;
tree gfor_fndecl_zgemm;
+/* RANDOM_INIT function. */
+tree gfor_fndecl_random_init;
static void
gfc_add_decl_to_parent_function (tree decl)
@@ -3328,6 +3330,11 @@ gfc_build_intrinsic_function_decls (void)
void_type_node, 3, pchar_type_node, gfc_charlen_type_node,
gfc_int8_type_node);
+ gfor_fndecl_random_init = gfc_build_library_function_decl (
+ get_identifier (PREFIX("random_init")),
+ void_type_node, 3, gfc_logical4_type_node, gfc_logical4_type_node,
+ gfc_int4_type_node);
+
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);
diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index fa01971..d306e3a 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -3635,6 +3635,52 @@ conv_intrinsic_free (gfc_code *code)
}
+/* Call the RANDOM_INIT library subroutine with a hidden argument for
+ handling seeding on coarray images. */
+
+static tree
+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);
+
+ /* Make the function call. */
+ gfc_init_block (&block);
+ gfc_init_se (&se, NULL);
+
+ /* Convert REPEATABLE to a LOGICAL(4) 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));
+ gfc_add_block_to_block (&block, &se.post);
+
+ /* Convert IMAGE_DISTINCT to a LOGICAL(4) 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));
+ 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_random_init, 3,
+ arg1, arg2, arg3);
+ gfc_add_expr_to_block (&block, tmp);
+
+ return gfc_finish_block (&block);
+}
+
+
/* Call the SYSTEM_CLOCK library functions, handling the type and kind
conversions. */
@@ -11064,6 +11110,10 @@ gfc_conv_intrinsic_subroutine (gfc_code *code)
res = conv_intrinsic_free (code);
break;
+ case GFC_ISYM_RANDOM_INIT:
+ res = conv_intrinsic_random_init (code);
+ break;
+
case GFC_ISYM_KILL:
res = conv_intrinsic_kill_sub (code);
break;
diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index c6b3625..049fcd6 100644
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -915,6 +915,8 @@ extern GTY(()) tree gfor_fndecl_sr_kind;
extern GTY(()) tree gfor_fndecl_ieee_procedure_entry;
extern GTY(()) tree gfor_fndecl_ieee_procedure_exit;
+/* RANDOM_INIT. */
+extern GTY(()) tree gfor_fndecl_random_init;
/* True if node is an integer constant. */
#define INTEGER_CST_P(node) (TREE_CODE(node) == INTEGER_CST)
--
cgit v1.1