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();
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
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;
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]);
}
}
+#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);
*/
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;
{
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;
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))
#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,
close(tmpfd);
} else
Perl_croak(aTHX_ err);
-#else
-# ifdef HAS_MKTEMP
- scriptname = mktemp(tmpname);
- if (!scriptname)
- Perl_croak(aTHX_ err);
-# endif
#endif
}
#endif
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;