From patchwork Wed Sep 18 20:22:15 2024 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Thomas Koenig X-Patchwork-Id: 1986977 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@legolas.ozlabs.org Authentication-Results: legolas.ozlabs.org; dkim=pass (2048-bit key; unprotected) header.d=netcologne.de header.i=@netcologne.de header.a=rsa-sha256 header.s=nc1116a header.b=Xq8Rpxf5; dkim-atps=neutral Authentication-Results: legolas.ozlabs.org; spf=pass (sender SPF authorized) smtp.mailfrom=gcc.gnu.org (client-ip=2620:52:3:1:0:246e:9693:128c; helo=server2.sourceware.org; envelope-from=gcc-patches-bounces~incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=patchwork.ozlabs.org) Received: from server2.sourceware.org (server2.sourceware.org [IPv6:2620:52:3:1:0:246e:9693:128c]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits) key-exchange X25519 server-signature ECDSA (secp384r1) server-digest SHA384) (No client certificate requested) by legolas.ozlabs.org (Postfix) with ESMTPS id 4X897V0wp4z1y2j for ; Thu, 19 Sep 2024 06:22:45 +1000 (AEST) Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 0A756385C6C2 for ; Wed, 18 Sep 2024 20:22:43 +0000 (GMT) X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from cc-smtpout3.netcologne.de (cc-smtpout3.netcologne.de [IPv6:2001:4dd0:100:1062:25:2:0:3]) by sourceware.org (Postfix) with ESMTPS id 100FB385C6CD; Wed, 18 Sep 2024 20:22:18 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org 100FB385C6CD Authentication-Results: sourceware.org; dmarc=pass (p=none dis=none) header.from=netcologne.de Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=netcologne.de ARC-Filter: OpenARC Filter v1.0.0 sourceware.org 100FB385C6CD Authentication-Results: server2.sourceware.org; arc=none smtp.remote-ip=2001:4dd0:100:1062:25:2:0:3 ARC-Seal: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1726690941; cv=none; b=VH54J9HcGGFao1iNiCsh4hM2bNzXcqwsb24603F/6ZHZYbASyJGbfParIz5S0yVDiO2lrfslL6dFgWlSnZeYe6EBO9ABZRnPaEQ4hZfpn8z4Nq4pbyRn6WiZedy11V/KX0Y5orvdQCN2iHCDDT1RqRL8CLDpDkAFZs5xYI0lr0M= ARC-Message-Signature: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1726690941; c=relaxed/simple; bh=HMLalw/G+3lBvPnqPk+WjgSxbJvInrhdmDrTmxXWo6U=; h=DKIM-Signature:Message-ID:Date:MIME-Version:To:From:Subject; b=JloravoHn9DvhrdpnOLgTKmp8htx7dQb31f8z2Ey/mkRQr3lnMXyhIHzS6njN0SYJV2d2TBGfOkhDvJPSov2iIr+DGzFQtk7mjXGE37hpo1onaTfhqXI3HtR2bL24CWsXxPGfA8Qr4Un1WumL6CeErKMKnCZw5G4ZpY28tPc9EE= ARC-Authentication-Results: i=1; server2.sourceware.org Received: from cc-smtpin3.netcologne.de (cc-smtpin3.netcologne.de [89.1.8.203]) by cc-smtpout3.netcologne.de (Postfix) with ESMTP id 030A21256F; Wed, 18 Sep 2024 22:22:17 +0200 (CEST) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=netcologne.de; s=nc1116a; t=1726690937; bh=HMLalw/G+3lBvPnqPk+WjgSxbJvInrhdmDrTmxXWo6U=; h=Message-ID:Date:To:From:Subject:From; b=Xq8Rpxf5UdAEHuFXXvidYFSzKYs4p8yKF99dj+1FhozEP8EJa2BR7IxERJuFacHpK TOO1oR/l+ofGNGM3w4MxQ0ob5KqBeyK2tjgPlevIKQ5smVKQAwi93fdjs0bOV5i0XD aMnCY11pDn2Lk84hK9ZYTH2QCsO3ud4Yt/50WPVUQxZ1/7FDk4PmcbjakTXJNoFg6C LVHW10+nV1ABX6XqHb9KOMZrLri1KdTcjTjYYmR0F5kDcgUhqZ49rQuArqvhKctMUL neKlXBGV1WMQT8NTPB80bbguMXJEKk9IYg6JTqK/8J+ZCfFOkotOZ5RwSJ6cppVUV+ iuMpdsWVUp/EA== Received: from [IPV6:2001:4dd7:e9b0:0:8fca:5aa0:12d1:3314] (2001-4dd7-e9b0-0-8fca-5aa0-12d1-3314.ipv6dyn.netcologne.de [IPv6:2001:4dd7:e9b0:0:8fca:5aa0:12d1:3314]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits) key-exchange X25519 server-signature RSA-PSS (4096 bits) server-digest SHA256) (No client certificate requested) by cc-smtpin3.netcologne.de (Postfix) with ESMTPSA id C8E2311DC0; Wed, 18 Sep 2024 22:22:15 +0200 (CEST) Message-ID: Date: Wed, 18 Sep 2024 22:22:15 +0200 MIME-Version: 1.0 User-Agent: Mozilla Thunderbird Content-Language: en-US, de-DE To: "fortran@gcc.gnu.org" , gcc-patches From: Thomas Koenig Subject: [patch, fortran] Add random numbers and fix some bugs. X-NetCologne-Spam: L X-Rspamd-Queue-Id: C8E2311DC0 X-Spamd-Bar: ---- X-Rspamd-Action: no action X-Spam-Status: No, score=-10.4 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, DKIM_VALID_AU, DKIM_VALID_EF, GIT_PATCH_0, RCVD_IN_DNSWL_LOW, SPF_HELO_NONE, SPF_PASS, TXREP autolearn=ham autolearn_force=no version=3.4.6 X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on server2.sourceware.org X-BeenThere: gcc-patches@gcc.gnu.org X-Mailman-Version: 2.1.30 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: gcc-patches-bounces~incoming=patchwork.ozlabs.org@gcc.gnu.org This patch adds random number support for UNSIGNED, plus fixes two bugs, with array I/O where the type used to be set to BT_INTEGER, and for division with the divisor being a constant. Again, depends on prevous submissions. OK for trunk? gcc/fortran/ChangeLog: * check.cc (gfc_check_random_number): Adjust for unsigned. * iresolve.cc (gfc_resolve_random_number): Handle unsinged. * trans-expr.cc (gfc_conv_expr_op): Handle BT_UNSIGNED for divide. * trans-types.cc (gfc_get_dtype_rank_type): Handle BT_UNSIGNED. * gfortran.texi: Add RANDOM_NUMBER for UNSIGNED. libgfortran/ChangeLog: * gfortran.map: Add _gfortran_random_m1, _gfortran_random_m2, _gfortran_random_m4, _gfortran_random_m8 and _gfortran_random_m16. * intrinsics/random.c (random_m1): New function. (random_m2): New function. (random_m4): New function. (random_m8): New function. (random_m16): New function. (arandom_m1): New function. (arandom_m2): New function. (arandom_m4): New function. (arandom_m8): New funciton. (arandom_m16): New function. gcc/testsuite/ChangeLog: * gfortran.dg/unsigned_30.f90: New test. --- gcc/fortran/check.cc | 10 +- gcc/fortran/gfortran.texi | 1 + gcc/fortran/iresolve.cc | 6 +- gcc/fortran/trans-expr.cc | 4 +- gcc/fortran/trans-types.cc | 7 +- gcc/testsuite/gfortran.dg/unsigned_30.f90 | 63 ++++ libgfortran/gfortran.map | 10 + libgfortran/intrinsics/random.c | 440 ++++++++++++++++++++++ 8 files changed, 534 insertions(+), 7 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/unsigned_30.f90 diff --git a/gcc/fortran/check.cc b/gcc/fortran/check.cc index 533c9d7d343..1851cfb8d4a 100644 --- a/gcc/fortran/check.cc +++ b/gcc/fortran/check.cc @@ -7007,8 +7007,14 @@ gfc_check_random_init (gfc_expr *repeatable, gfc_expr *image_distinct) bool gfc_check_random_number (gfc_expr *harvest) { - if (!type_check (harvest, 0, BT_REAL)) - return false; + if (flag_unsigned) + { + if (!type_check2 (harvest, 0, BT_REAL, BT_UNSIGNED)) + return false; + } + else + if (!type_check (harvest, 0, BT_REAL)) + return false; if (!variable_check (harvest, 0, false)) return false; diff --git a/gcc/fortran/gfortran.texi b/gcc/fortran/gfortran.texi index 3eb8039c09f..a5ebadff3bb 100644 --- a/gcc/fortran/gfortran.texi +++ b/gcc/fortran/gfortran.texi @@ -2790,6 +2790,7 @@ As of now, the following intrinsics take unsigned arguments: @item @code{TRANSFER} @item @code{SUM}, @code{PRODUCT}, @code{MATMUL} and @code{DOT_PRODUCT} @item @code{IANY}, @code{IALL} and @code{IPARITY} +@item @code{RANDOM_NUMBER}. @end itemize This list will grow in the near future. @c --------------------------------------------------------------------- diff --git a/gcc/fortran/iresolve.cc b/gcc/fortran/iresolve.cc index 58a1821ef10..a814c9279cf 100644 --- a/gcc/fortran/iresolve.cc +++ b/gcc/fortran/iresolve.cc @@ -3452,12 +3452,14 @@ gfc_resolve_random_number (gfc_code *c) { const char *name; int kind; + char type; kind = gfc_type_abi_kind (&c->ext.actual->expr->ts); + type = gfc_type_letter (c->ext.actual->expr->ts.type); if (c->ext.actual->expr->rank == 0) - name = gfc_get_string (PREFIX ("random_r%d"), kind); + name = gfc_get_string (PREFIX ("random_%c%d"), type, kind); else - name = gfc_get_string (PREFIX ("arandom_r%d"), kind); + name = gfc_get_string (PREFIX ("arandom_%c%d"), type, kind); c->resolved_sym = gfc_get_intrinsic_sub_symbol (name); } diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc index f1dfac4a2be..b39b4450997 100644 --- a/gcc/fortran/trans-expr.cc +++ b/gcc/fortran/trans-expr.cc @@ -3982,9 +3982,9 @@ gfc_conv_expr_op (gfc_se * se, gfc_expr * expr) case INTRINSIC_DIVIDE: /* If expr is a real or complex expr, use an RDIV_EXPR. If op1 is - an integer, we must round towards zero, so we use a + an integer or unsigned, we must round towards zero, so we use a TRUNC_DIV_EXPR. */ - if (expr->ts.type == BT_INTEGER) + if (expr->ts.type == BT_INTEGER || expr->ts.type == BT_UNSIGNED) code = TRUNC_DIV_EXPR; else code = RDIV_EXPR; diff --git a/gcc/fortran/trans-types.cc b/gcc/fortran/trans-types.cc index 3a1ff98b33c..ce7d3027f1b 100644 --- a/gcc/fortran/trans-types.cc +++ b/gcc/fortran/trans-types.cc @@ -1651,7 +1651,12 @@ gfc_get_dtype_rank_type (int rank, tree etype) && TYPE_STRING_FLAG (ptype)) n = BT_CHARACTER; else - n = BT_INTEGER; + { + if (TYPE_UNSIGNED (etype)) + n = BT_UNSIGNED; + else + n = BT_INTEGER; + } break; case BOOLEAN_TYPE: diff --git a/gcc/testsuite/gfortran.dg/unsigned_30.f90 b/gcc/testsuite/gfortran.dg/unsigned_30.f90 new file mode 100644 index 00000000000..b0a15552f1f --- /dev/null +++ b/gcc/testsuite/gfortran.dg/unsigned_30.f90 @@ -0,0 +1,63 @@ +! { dg-do run } +! { dg-options "-funsigned" } + +! The leading bytes of the unsigned sequences should be the same for +! kinds 1 to 8. This also tests array I/O for unsigneds. + +program memain + implicit none + integer, dimension(:), allocatable :: seed + integer :: n + call random_seed (size=n) + allocate(seed(n)) + call test1 + call test2 +contains + subroutine test1 + unsigned(1) :: u1 + unsigned(2) :: u2 + unsigned(4) :: u4 + unsigned(8) :: u8 + character (len=16) :: line1, line2, line4, line8 + integer :: i, n + do i=1,10 + call random_seed(get=seed) + call random_number(u1) + write (line1,'(Z2.2)') u1 + call random_seed(put=seed) + call random_number(u2) + write (line2,'(Z4.4)') u2 + call random_seed(put=seed) + call random_number(u4) + write (line4,'(Z8.8)') u4 + call random_seed(put=seed) + call random_number(u8) + write (line8,'(Z16.16)') u8 + if (line8(1:8) /= line4 (1:8)) error stop 1 + if (line4(1:4) /= line2 (1:4)) error stop 2 + if (line2(1:2) /= line1 (1:2)) error stop 3 + end do + end subroutine test1 + subroutine test2 + unsigned(1), dimension(2,2) :: v1 + unsigned(2), dimension(2,2) :: v2 + unsigned(4), dimension(2,2) :: v4 + unsigned(8), dimension(2,2) :: v8 + character(len=16), dimension(4) :: c1, c2, c4, c8 + call random_seed(put=seed) + call random_number (v1) + write (c1,'(Z2.2)') v1 + call random_seed(put=seed) + call random_number (v2) + write (c2,'(Z4.4)') v2 + call random_seed(put=seed) + call random_number (v4) + write (c4,'(Z8.8)') v4 + call random_seed(put=seed) + call random_number (v8) + write (c8,'(Z16.16)') v8 + if (any(c8(:)(1:8) /= c4(:)(1:8))) error stop 10 + if (any(c4(:)(1:4) /= c2(:)(1:4))) error stop 11 + if (any(c2(:)(1:2) /= c1(:)(1:2))) error stop 12 + end subroutine test2 +end program memain diff --git a/libgfortran/gfortran.map b/libgfortran/gfortran.map index e71cbcf2376..6c42b167430 100644 --- a/libgfortran/gfortran.map +++ b/libgfortran/gfortran.map @@ -1777,4 +1777,14 @@ GFORTRAN_15 { _gfortran_internal_unpack_class; _gfortran_transfer_unsigned; _gfortran_transfer_unsigned_write; + _gfortran_random_m1; + _gfortran_random_m2; + _gfortran_random_m4; + _gfortran_random_m8; + _gfortran_random_m16; + _gfortran_arandom_m1; + _gfortran_arandom_m2; + _gfortran_arandom_m4; + _gfortran_arandom_m8; + _gfortran_arandom_m16; } GFORTRAN_14; diff --git a/libgfortran/intrinsics/random.c b/libgfortran/intrinsics/random.c index 93de41dc3b3..9922224b687 100644 --- a/libgfortran/intrinsics/random.c +++ b/libgfortran/intrinsics/random.c @@ -89,6 +89,43 @@ export_proto(arandom_r17); #endif +extern void random_m1 (GFC_UINTEGER_1 *); +export_proto (random_m1); + +extern void random_m2 (GFC_UINTEGER_2 *); +export_proto (random_m2); + +extern void random_m4 (GFC_UINTEGER_4 *); +export_proto (random_m4); + +extern void random_m8 (GFC_UINTEGER_8 *); +export_proto (random_m8); + +#ifdef HAVE_GFC_UINTEGER_16 +extern void random_m16 (GFC_UINTEGER_16 *); +export_proto (random_m16); + +#endif + +extern void arandom_m1 (gfc_array_m1 *); +export_proto (arandom_m1); + +extern void arandom_m2 (gfc_array_m2 *); +export_proto (arandom_m2); + +extern void arandom_m4 (gfc_array_m4 *); +export_proto (arandom_m4); + +extern void arandom_m8 (gfc_array_m8 *); +export_proto (arandom_m8); + +#ifdef HAVE_GFC_UINTEGER_16 + +extern void arandom_m16 (gfc_array_m16 *); +export_proto (arandom_m16); + +#endif + #ifdef __GTHREAD_MUTEX_INIT static __gthread_mutex_t random_lock = __GTHREAD_MUTEX_INIT; #else @@ -498,6 +535,81 @@ iexport(random_r17); #endif +/* Versions for unsigned numbers. */ + +/* Returns a random byte. */ + +void +random_m1 (GFC_UINTEGER_1 *x) +{ + prng_state* rs = get_rand_state(); + + if (unlikely (!rs->init)) + init_rand_state (rs, false); + GFC_UINTEGER_8 r = prng_next (rs); + + *x = r >> 56; +} + +/* A random 16-bit number. */ + +void +random_m2 (GFC_UINTEGER_2 *x) +{ + prng_state* rs = get_rand_state(); + + if (unlikely (!rs->init)) + init_rand_state (rs, false); + GFC_UINTEGER_8 r = prng_next (rs); + + *x = r >> 48; +} + +/* A random 32-bit number. */ + +void +random_m4 (GFC_UINTEGER_4 *x) +{ + prng_state* rs = get_rand_state(); + + if (unlikely (!rs->init)) + init_rand_state (rs, false); + GFC_UINTEGER_8 r = prng_next (rs); + + *x = r >> 32; +} + +/* A random 64-bit number. */ + +void +random_m8 (GFC_UINTEGER_8 *x) +{ + prng_state* rs = get_rand_state(); + + if (unlikely (!rs->init)) + init_rand_state (rs, false); + GFC_UINTEGER_8 r = prng_next (rs); + + *x = r; +} + +/* ... and a random 128-bit number, if we have the type. */ + +#ifdef HAVE_GFC_UINTEGER_16 +void +random_m16 (GFC_UINTEGER_16 *x) +{ + prng_state* rs = get_rand_state(); + + if (unlikely (!rs->init)) + init_rand_state (rs, false); + GFC_UINTEGER_8 r1 = prng_next (rs); + GFC_UINTEGER_8 r2 = prng_next (rs); + + *x = (((GFC_UINTEGER_16) r1) << 64) | (GFC_UINTEGER_16) r2; +} +#endif + /* This function fills a REAL(4) array with values from the uniform distribution with range [0,1). */ @@ -843,6 +955,334 @@ arandom_r17 (gfc_array_r17 *x) #endif +/* Fill an unsigned array with random bytes. */ + +void +arandom_m1 (gfc_array_m1 *x) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type stride[GFC_MAX_DIMENSIONS]; + index_type stride0; + index_type dim; + GFC_UINTEGER_1 *dest; + prng_state* rs = get_rand_state(); + + dest = x->base_addr; + + dim = GFC_DESCRIPTOR_RANK (x); + + for (index_type n = 0; n < dim; n++) + { + count[n] = 0; + stride[n] = GFC_DESCRIPTOR_STRIDE(x,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(x,n); + if (extent[n] <= 0) + return; + } + + stride0 = stride[0]; + + if (unlikely (!rs->init)) + init_rand_state (rs, false); + + while (dest) + { + /* random_m1 (dest); */ + uint64_t r = prng_next (rs); + *dest = r >> 56; + + /* Advance to the next element. */ + dest += stride0; + count[0]++; + /* Advance to the next source element. */ + index_type n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + dest -= stride[n] * extent[n]; + n++; + if (n == dim) + { + dest = NULL; + break; + } + else + { + count[n]++; + dest += stride[n]; + } + } + } +} + +/* Fill an unsigned array with random 16-bit unsigneds. */ + +void +arandom_m2 (gfc_array_m2 *x) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type stride[GFC_MAX_DIMENSIONS]; + index_type stride0; + index_type dim; + GFC_UINTEGER_2 *dest; + prng_state* rs = get_rand_state(); + + dest = x->base_addr; + + dim = GFC_DESCRIPTOR_RANK (x); + + for (index_type n = 0; n < dim; n++) + { + count[n] = 0; + stride[n] = GFC_DESCRIPTOR_STRIDE(x,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(x,n); + if (extent[n] <= 0) + return; + } + + stride0 = stride[0]; + + if (unlikely (!rs->init)) + init_rand_state (rs, false); + + while (dest) + { + /* random_m1 (dest); */ + uint64_t r = prng_next (rs); + *dest = r >> 48; + + /* Advance to the next element. */ + dest += stride0; + count[0]++; + /* Advance to the next source element. */ + index_type n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + dest -= stride[n] * extent[n]; + n++; + if (n == dim) + { + dest = NULL; + break; + } + else + { + count[n]++; + dest += stride[n]; + } + } + } +} + +/* Fill an array with random 32-bit unsigneds. */ + +void +arandom_m4 (gfc_array_m4 *x) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type stride[GFC_MAX_DIMENSIONS]; + index_type stride0; + index_type dim; + GFC_UINTEGER_4 *dest; + prng_state* rs = get_rand_state(); + + dest = x->base_addr; + + dim = GFC_DESCRIPTOR_RANK (x); + + for (index_type n = 0; n < dim; n++) + { + count[n] = 0; + stride[n] = GFC_DESCRIPTOR_STRIDE(x,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(x,n); + if (extent[n] <= 0) + return; + } + + stride0 = stride[0]; + + if (unlikely (!rs->init)) + init_rand_state (rs, false); + + while (dest) + { + /* random_m4 (dest); */ + uint64_t r = prng_next (rs); + *dest = r >> 32; + + /* Advance to the next element. */ + dest += stride0; + count[0]++; + /* Advance to the next source element. */ + index_type n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + dest -= stride[n] * extent[n]; + n++; + if (n == dim) + { + dest = NULL; + break; + } + else + { + count[n]++; + dest += stride[n]; + } + } + } +} + +/* Fill an array with random 64-bit unsigneds. */ + +void +arandom_m8 (gfc_array_m8 *x) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type stride[GFC_MAX_DIMENSIONS]; + index_type stride0; + index_type dim; + GFC_UINTEGER_8 *dest; + prng_state* rs = get_rand_state(); + + dest = x->base_addr; + + dim = GFC_DESCRIPTOR_RANK (x); + + for (index_type n = 0; n < dim; n++) + { + count[n] = 0; + stride[n] = GFC_DESCRIPTOR_STRIDE(x,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(x,n); + if (extent[n] <= 0) + return; + } + + stride0 = stride[0]; + + if (unlikely (!rs->init)) + init_rand_state (rs, false); + + while (dest) + { + /* random_m8 (dest); */ + uint64_t r = prng_next (rs); + *dest = r; + + /* Advance to the next element. */ + dest += stride0; + count[0]++; + /* Advance to the next source element. */ + index_type n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + dest -= stride[n] * extent[n]; + n++; + if (n == dim) + { + dest = NULL; + break; + } + else + { + count[n]++; + dest += stride[n]; + } + } + } +} + +#ifdef GFC_HAVE_GFC_UINTEGER_16 + +/* Fill an unsigned array with random bytes. */ + +void +arandom_m16 (gfc_array_m16 *x) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type stride[GFC_MAX_DIMENSIONS]; + index_type stride0; + index_type dim; + GFC_UINTEGER_16 *dest; + prng_state* rs = get_rand_state(); + + dest = x->base_addr; + + dim = GFC_DESCRIPTOR_RANK (x); + + for (index_type n = 0; n < dim; n++) + { + count[n] = 0; + stride[n] = GFC_DESCRIPTOR_STRIDE(x,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(x,n); + if (extent[n] <= 0) + return; + } + + stride0 = stride[0]; + + if (unlikely (!rs->init)) + init_rand_state (rs, false); + + while (dest) + { + /* random_m16 (dest); */ + uint64_t r1 = prng_next (rs), r2 = prng_next (rs); + *dest = (((GFC_UINTEGER_16) r1) << 64) | (GFC_UINTEGER_16) r2; + + /* Advance to the next element. */ + dest += stride0; + count[0]++; + /* Advance to the next source element. */ + index_type n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + dest -= stride[n] * extent[n]; + n++; + if (n == dim) + { + dest = NULL; + break; + } + else + { + count[n]++; + dest += stride[n]; + } + } + } +} + +#endif /* Number of elements in master_state array. */ #define SZU64 (sizeof (master_state.s) / sizeof (uint64_t))