Don't use VOL internally, because "volatile" works just fine

[perl5.git] / perl.c

diff --git a/perl.c b/perl.c
index d7b0866..2540cb3 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -273,6 +273,26 @@ perl_construct(pTHXx)
 
     init_stacks();
 
+/* The PERL_INTERNAL_RAND_SEED set-up must be after init_stacks because it calls
+ * things that may put SVs on the stack.
+ */
+
+#ifdef NO_PERL_INTERNAL_RAND_SEED
+    Perl_drand48_init_r(&PL_internal_random_state, seed());
+#else
+    {
+        UV seed;
+        const char *env_pv;
+        if (PerlProc_getuid() != PerlProc_geteuid() ||
+            PerlProc_getgid() != PerlProc_getegid() ||
+            !(env_pv = PerlEnv_getenv("PERL_INTERNAL_RAND_SEED")) ||
+            grok_number(env_pv, strlen(env_pv), &seed) != IS_NUMBER_IN_UV) {
+            seed = seed();
+        }
+        Perl_drand48_init_r(&PL_internal_random_state, (U32)seed);
+    }
+#endif
+
     init_ids();
 
     S_fixup_platform_bugs();
@@ -286,6 +306,14 @@ perl_construct(pTHXx)
     PL_localpatches = local_patches;   /* For possible -v */
 #endif
 
+#if defined(LIBM_LIB_VERSION)
+    /*
+     * Some BSDs and Cygwin default to POSIX math instead of IEEE.
+     * This switches them over to IEEE.
+     */
+    _LIB_VERSION = _IEEE_;
+#endif
+
 #ifdef HAVE_INTERP_INTERN
     sys_intern_init();
 #endif
@@ -448,7 +476,7 @@ perl_construct(pTHXx)
     PL_WB_invlist = _new_invlist_C_array(_Perl_WB_invlist);
     PL_LB_invlist = _new_invlist_C_array(_Perl_LB_invlist);
     PL_Assigned_invlist = _new_invlist_C_array(Assigned_invlist);
-#ifdef USE_THREAD_SAFE_LOCALE
+#ifdef HAS_POSIX_2008_LOCALE
     PL_C_locale_obj = newlocale(LC_ALL_MASK, "C", NULL);
 #endif
 
@@ -583,7 +611,7 @@ int
 perl_destruct(pTHXx)
 {
     dVAR;
-    VOL signed char destruct_level;  /* see possible values in intrpvar.h */
+    volatile signed char destruct_level;  /* see possible values in intrpvar.h */
     HV *hv;
 #ifdef DEBUG_LEAKING_SCALARS_FORK_DUMP
     pid_t child;
@@ -1107,6 +1135,11 @@ perl_destruct(pTHXx)
     PL_numeric_radix_sv = NULL;
 #endif
 
+    if (PL_langinfo_buf) {
+        Safefree(PL_langinfo_buf);
+        PL_langinfo_buf = NULL;
+    }
+
     /* clear character classes  */
     for (i = 0; i < POSIX_SWASH_COUNT; i++) {
         SvREFCNT_dec(PL_utf8_swash_ptrs[i]);
@@ -1287,6 +1320,11 @@ perl_destruct(pTHXx)
     SvANY(&PL_sv_no) = NULL;
     SvFLAGS(&PL_sv_no) = 0;
 
+    SvREFCNT(&PL_sv_zero) = 0;
+    sv_clear(&PL_sv_zero);
+    SvANY(&PL_sv_zero) = NULL;
+    SvFLAGS(&PL_sv_zero) = 0;
+
     {
         int i;
         for (i=0; i<=2; i++) {
@@ -2184,6 +2222,21 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
     }
     }
 
+#ifndef NO_PERL_INTERNAL_RAND_SEED
+    /* If we're not set[ug]id, we might have honored
+       PERL_INTERNAL_RAND_SEED in perl_construct().
+       At this point command-line options have been parsed, so if
+       we're now tainting and not set[ug]id re-seed.
+       This could possibly be wasteful if PERL_INTERNAL_RAND_SEED is invalid,
+       but avoids duplicating the logic from perl_construct().
+    */
+    if (PL_tainting &&
+        PerlProc_getuid() == PerlProc_geteuid() &&
+        PerlProc_getgid() == PerlProc_getegid()) {
+        Perl_drand48_init_r(&PL_internal_random_state, seed());
+    }
+#endif
+
     /* Set $^X early so that it can be used for relocatable paths in @INC  */
     /* and for SITELIB_EXP in USE_SITECUSTOMIZE                            */
     assert (!TAINT_get);
@@ -2785,14 +2838,14 @@ See L<perlcall>.
 */
 
 I32
-Perl_call_sv(pTHX_ SV *sv, VOL I32 flags)
+Perl_call_sv(pTHX_ SV *sv, volatile I32 flags)
                        /* See G_* flags in cop.h */
 {
     dVAR;
     LOGOP myop;                /* fake syntax tree node */
     METHOP method_op;
     I32 oldmark;
-    VOL I32 retval = 0;
+    volatile I32 retval = 0;
     bool oldcatch = CATCH_GET;
     int ret;
     OP* const oldop = PL_op;
@@ -2940,8 +2993,8 @@ Perl_eval_sv(pTHX_ SV *sv, I32 flags)
 {
     dVAR;
     UNOP myop;         /* fake syntax tree node */
-    VOL I32 oldmark;
-    VOL I32 retval = 0;
+    volatile I32 oldmark;
+    volatile I32 retval = 0;
     int ret;
     OP* const oldop = PL_op;
     dJMPENV;
@@ -3358,12 +3411,6 @@ Perl_moreswitches(pTHX_ const char *s)
 
     case 'i':
        Safefree(PL_inplace);
-#if defined(__CYGWIN__) /* do backup extension automagically */
-       if (*(s+1) == '\0') {
-       PL_inplace = savepvs(".bak");
-       return s+1;
-       }
-#endif /* __CYGWIN__ */
        {
            const char * const start = ++s;
            while (*s && !isSPACE(*s))
@@ -3776,7 +3823,6 @@ S_init_main_stash(pTHX)
 #endif
     sv_grow(ERRSV, 240);       /* Preallocate - for immediate signals. */
     CLEAR_ERRSV();
-    SET_CURSTASH(PL_defstash);
     CopSTASH_set(&PL_compiling, PL_defstash);
     PL_debstash = GvHV(gv_fetchpvs("DB::", GV_ADDMULTI, SVt_PVHV));
     PL_globalstash = GvHV(gv_fetchpvs("CORE::GLOBAL::", GV_ADDMULTI,
@@ -3875,12 +3921,6 @@ S_open_script(pTHX_ const char *scriptname, bool dosearch, bool *suidscript)
                close(tmpfd);
            } else
                Perl_croak(aTHX_ err);
-#else
-#  ifdef HAS_MKTEMP
-           scriptname = mktemp(tmpname);
-           if (!scriptname)
-               Perl_croak(aTHX_ err);
-#  endif
 #endif
        }
 #endif
@@ -4161,6 +4201,9 @@ Perl_init_stacks(pTHX)
     PL_curstackinfo = new_stackinfo(REASONABLE(128),
                                 REASONABLE(8192/sizeof(PERL_CONTEXT) - 1));
     PL_curstackinfo->si_type = PERLSI_MAIN;
+#if defined DEBUGGING && !defined DEBUGGING_RE_ONLY
+    PL_curstackinfo->si_stack_hwm = 0;
+#endif
     PL_curstack = PL_curstackinfo->si_stack;
     PL_mainstack = PL_curstack;                /* remember in case we switch stacks */
 
@@ -5008,7 +5051,7 @@ void
 Perl_call_list(pTHX_ I32 oldscope, AV *paramList)
 {
     SV *atsv;
-    VOL const line_t oldline = PL_curcop ? CopLINE(PL_curcop) : 0;
+    volatile const line_t oldline = PL_curcop ? CopLINE(PL_curcop) : 0;
     CV *cv;
     STRLEN len;
     int ret;