Move the (pseudo)seed functio for (pseudo)random numbers to util.c.

p4raw-id: //depot/perl@19843

diff --git a/embed.fnc b/embed.fnc
index d7acddd..954f358 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -836,6 +836,7 @@ p   |void   |vivify_defelem |SV* sv
 p      |void   |vivify_ref     |SV* sv|U32 to_what
 p      |I32    |wait4pid       |Pid_t pid|int* statusp|int flags
 p      |U32    |parse_unicode_opts|char **popt
+p      |U32    |seed
 p      |void   |report_evil_fh |GV *gv|IO *io|I32 op
 pd     |void   |report_uninit
 Afpd   |void   |warn           |const char* pat|...
@@ -1060,7 +1061,6 @@ s |void*  |vcall_list_body|va_list args
 
 #if defined(PERL_IN_PP_C) || defined(PERL_DECL_PROT)
 s      |SV*    |refto          |SV* sv
-s      |U32    |seed
 #endif
 
 #if defined(PERL_IN_PP_PACK_C) || defined(PERL_DECL_PROT)

diff --git a/embed.h b/embed.h
index b1541c7..14b5343 100644 (file)
--- a/embed.h
+++ b/embed.h
@@ -1110,6 +1110,9 @@
 #define parse_unicode_opts     Perl_parse_unicode_opts
 #endif
 #ifdef PERL_CORE
+#define seed                   Perl_seed
+#endif
+#ifdef PERL_CORE
 #define report_evil_fh         Perl_report_evil_fh
 #endif
 #ifdef PERL_CORE
@@ -1470,9 +1473,6 @@
 #ifdef PERL_CORE
 #define refto                  S_refto
 #endif
-#ifdef PERL_CORE
-#define seed                   S_seed
-#endif
 #endif
 #if defined(PERL_IN_PP_PACK_C) || defined(PERL_DECL_PROT)
 #ifdef PERL_CORE
@@ -3591,6 +3591,9 @@
 #define parse_unicode_opts(a)  Perl_parse_unicode_opts(aTHX_ a)
 #endif
 #ifdef PERL_CORE
+#define seed()                 Perl_seed(aTHX)
+#endif
+#ifdef PERL_CORE
 #define report_evil_fh(a,b,c)  Perl_report_evil_fh(aTHX_ a,b,c)
 #endif
 #ifdef PERL_CORE
@@ -3945,9 +3948,6 @@
 #ifdef PERL_CORE
 #define refto(a)               S_refto(aTHX_ a)
 #endif
-#ifdef PERL_CORE
-#define seed()                 S_seed(aTHX)
-#endif
 #endif
 #if defined(PERL_IN_PP_PACK_C) || defined(PERL_DECL_PROT)
 #ifdef PERL_CORE

diff --git a/pp.c b/pp.c
index fc6a7bf..910101a 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -2727,87 +2727,6 @@ PP(pp_srand)
     RETPUSHYES;
 }
 
-STATIC U32
-S_seed(pTHX)
-{
-    /*
-     * This is really just a quick hack which grabs various garbage
-     * values.  It really should be a real hash algorithm which
-     * spreads the effect of every input bit onto every output bit,
-     * if someone who knows about such things would bother to write it.
-     * Might be a good idea to add that function to CORE as well.
-     * No numbers below come from careful analysis or anything here,
-     * except they are primes and SEED_C1 > 1E6 to get a full-width
-     * value from (tv_sec * SEED_C1 + tv_usec).  The multipliers should
-     * probably be bigger too.
-     */
-#if RANDBITS > 16
-#  define SEED_C1      1000003
-#define   SEED_C4      73819
-#else
-#  define SEED_C1      25747
-#define   SEED_C4      20639
-#endif
-#define   SEED_C2      3
-#define   SEED_C3      269
-#define   SEED_C5      26107
-
-#ifndef PERL_NO_DEV_RANDOM
-    int fd;
-#endif
-    U32 u;
-#ifdef VMS
-#  include <starlet.h>
-    /* when[] = (low 32 bits, high 32 bits) of time since epoch
-     * in 100-ns units, typically incremented ever 10 ms.        */
-    unsigned int when[2];
-#else
-#  ifdef HAS_GETTIMEOFDAY
-    struct timeval when;
-#  else
-    Time_t when;
-#  endif
-#endif
-
-/* This test is an escape hatch, this symbol isn't set by Configure. */
-#ifndef PERL_NO_DEV_RANDOM
-#ifndef PERL_RANDOM_DEVICE
-   /* /dev/random isn't used by default because reads from it will block
-    * if there isn't enough entropy available.  You can compile with
-    * PERL_RANDOM_DEVICE to it if you'd prefer Perl to block until there
-    * is enough real entropy to fill the seed. */
-#  define PERL_RANDOM_DEVICE "/dev/urandom"
-#endif
-    fd = PerlLIO_open(PERL_RANDOM_DEVICE, 0);
-    if (fd != -1) {
-       if (PerlLIO_read(fd, &u, sizeof u) != sizeof u)
-           u = 0;
-       PerlLIO_close(fd);
-       if (u)
-           return u;
-    }
-#endif
-
-#ifdef VMS
-    _ckvmssts(sys$gettim(when));
-    u = (U32)SEED_C1 * when[0] + (U32)SEED_C2 * when[1];
-#else
-#  ifdef HAS_GETTIMEOFDAY
-    PerlProc_gettimeofday(&when,NULL);
-    u = (U32)SEED_C1 * when.tv_sec + (U32)SEED_C2 * when.tv_usec;
-#  else
-    (void)time(&when);
-    u = (U32)SEED_C1 * when;
-#  endif
-#endif
-    u += SEED_C3 * (U32)PerlProc_getpid();
-    u += SEED_C4 * (U32)PTR2UV(PL_stack_sp);
-#ifndef PLAN9           /* XXX Plan9 assembler chokes on this; fix needed  */
-    u += SEED_C5 * (U32)PTR2UV(&when);
-#endif
-    return u;
-}
-
 PP(pp_exp)
 {
     dSP; dTARGET; tryAMAGICun(exp);

diff --git a/proto.h b/proto.h
index 01e96ff..fee6d0a 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -796,6 +796,7 @@ PERL_CALLCONV void  Perl_vivify_defelem(pTHX_ SV* sv);
 PERL_CALLCONV void     Perl_vivify_ref(pTHX_ SV* sv, U32 to_what);
 PERL_CALLCONV I32      Perl_wait4pid(pTHX_ Pid_t pid, int* statusp, int flags);
 PERL_CALLCONV U32      Perl_parse_unicode_opts(pTHX_ char **popt);
+PERL_CALLCONV U32      Perl_seed(pTHX);
 PERL_CALLCONV void     Perl_report_evil_fh(pTHX_ GV *gv, IO *io, I32 op);
 PERL_CALLCONV void     Perl_report_uninit(pTHX);
 PERL_CALLCONV void     Perl_warn(pTHX_ const char* pat, ...)
@@ -1016,7 +1017,6 @@ STATIC void*      S_vcall_list_body(pTHX_ va_list args);
 
 #if defined(PERL_IN_PP_C) || defined(PERL_DECL_PROT)
 STATIC SV*     S_refto(pTHX_ SV* sv);
-STATIC U32     S_seed(pTHX);
 #endif
 
 #if defined(PERL_IN_PP_PACK_C) || defined(PERL_DECL_PROT)

diff --git a/util.c b/util.c
index f6d6449..48f9058 100644 (file)
--- a/util.c
+++ b/util.c
@@ -4375,3 +4375,84 @@ Perl_parse_unicode_opts(pTHX_ char **popt)
   return opt;
 }
 
+U32
+Perl_seed(pTHX)
+{
+    /*
+     * This is really just a quick hack which grabs various garbage
+     * values.  It really should be a real hash algorithm which
+     * spreads the effect of every input bit onto every output bit,
+     * if someone who knows about such things would bother to write it.
+     * Might be a good idea to add that function to CORE as well.
+     * No numbers below come from careful analysis or anything here,
+     * except they are primes and SEED_C1 > 1E6 to get a full-width
+     * value from (tv_sec * SEED_C1 + tv_usec).  The multipliers should
+     * probably be bigger too.
+     */
+#if RANDBITS > 16
+#  define SEED_C1      1000003
+#define   SEED_C4      73819
+#else
+#  define SEED_C1      25747
+#define   SEED_C4      20639
+#endif
+#define   SEED_C2      3
+#define   SEED_C3      269
+#define   SEED_C5      26107
+
+#ifndef PERL_NO_DEV_RANDOM
+    int fd;
+#endif
+    U32 u;
+#ifdef VMS
+#  include <starlet.h>
+    /* when[] = (low 32 bits, high 32 bits) of time since epoch
+     * in 100-ns units, typically incremented ever 10 ms.        */
+    unsigned int when[2];
+#else
+#  ifdef HAS_GETTIMEOFDAY
+    struct timeval when;
+#  else
+    Time_t when;
+#  endif
+#endif
+
+/* This test is an escape hatch, this symbol isn't set by Configure. */
+#ifndef PERL_NO_DEV_RANDOM
+#ifndef PERL_RANDOM_DEVICE
+   /* /dev/random isn't used by default because reads from it will block
+    * if there isn't enough entropy available.  You can compile with
+    * PERL_RANDOM_DEVICE to it if you'd prefer Perl to block until there
+    * is enough real entropy to fill the seed. */
+#  define PERL_RANDOM_DEVICE "/dev/urandom"
+#endif
+    fd = PerlLIO_open(PERL_RANDOM_DEVICE, 0);
+    if (fd != -1) {
+       if (PerlLIO_read(fd, &u, sizeof u) != sizeof u)
+           u = 0;
+       PerlLIO_close(fd);
+       if (u)
+           return u;
+    }
+#endif
+
+#ifdef VMS
+    _ckvmssts(sys$gettim(when));
+    u = (U32)SEED_C1 * when[0] + (U32)SEED_C2 * when[1];
+#else
+#  ifdef HAS_GETTIMEOFDAY
+    PerlProc_gettimeofday(&when,NULL);
+    u = (U32)SEED_C1 * when.tv_sec + (U32)SEED_C2 * when.tv_usec;
+#  else
+    (void)time(&when);
+    u = (U32)SEED_C1 * when;
+#  endif
+#endif
+    u += SEED_C3 * (U32)PerlProc_getpid();
+    u += SEED_C4 * (U32)PTR2UV(PL_stack_sp);
+#ifndef PLAN9           /* XXX Plan9 assembler chokes on this; fix needed  */
+    u += SEED_C5 * (U32)PTR2UV(&when);
+#endif
+    return u;
+}
+