MUTEX_INIT(&PL_my_ctx_mutex);
# endif
}
- else {
+#if defined(USE_ITHREADS)
+ else
+#else
+ /* This always happens for non-ithreads */
+#endif
+ {
PERL_SET_THX(my_perl);
}
}
if (!PL_linestr) {
PL_curcop = &PL_compiling; /* needed by ckWARN, right away */
- PL_linestr = newSV(79);
- sv_upgrade(PL_linestr,SVt_PVIV);
+ PL_linestr = newSV_type(SVt_PVIV);
+ SvGROW(PL_linestr, 80);
if (!SvREADONLY(&PL_sv_undef)) {
/* set read-only and try to insure than we wont see REFCNT==0
sv_setpvn(PERL_DEBUG_PAD(1), "", 0); /* ext/re needs these */
sv_setpvn(PERL_DEBUG_PAD(2), "", 0); /* even without DEBUGGING. */
#ifdef USE_ITHREADS
- PL_regex_padav = newAV();
- av_push(PL_regex_padav,(SV*)newAV()); /* First entry is an array of empty elements */
+ /* First entry is an array of empty elements */
+ Perl_av_create_and_push(aTHX_ &PL_regex_padav,(SV*)newAV());
PL_regex_pad = AvARRAY(PL_regex_padav);
#endif
#ifdef USE_REENTRANT_API
PL_timesbase.tms_cstime = 0;
#endif
-#ifdef PERL_MAD
- PL_curforce = -1;
-#endif
-
ENTER;
}
#endif
PL_sv_count = 0;
+#ifdef PERL_DEBUG_READONLY_OPS
+ free(PL_slabs);
+ PL_slabs = NULL;
+ PL_slab_count = 0;
+#endif
#if defined(PERLIO_LAYERS)
/* No more IO - including error messages ! */
void
perl_free(pTHXx)
{
+ dVAR;
+
if (PL_veto_cleanup)
return;
break;
}
}
+
+#ifndef PERL_USE_SAFE_PUTENV
/* Can we grab env area too to be used as the area for $0? */
- if (s && PL_origenviron) {
+ if (s && PL_origenviron && !PL_use_safe_putenv) {
if ((PL_origenviron[0] == s + 1)
||
(aligned &&
}
}
}
+#endif /* !defined(PERL_USE_SAFE_PUTENV) */
+
PL_origalen = s ? s - PL_origargv[0] + 1 : 0;
}
{
SV *opts_prog;
- if (!PL_preambleav)
- PL_preambleav = newAV();
- av_push(PL_preambleav,
- newSVpvs("use Config;"));
+ Perl_av_create_and_push(aTHX_ &PL_preambleav, newSVpvs("use Config;"));
if (*++s != ':') {
STRLEN opts;
# ifdef NO_MATHOMS
" NO_MATHOMS"
# endif
+# ifdef PERL_DEBUG_READONLY_OPS
+ " PERL_DEBUG_READONLY_OPS"
+# endif
# ifdef PERL_DONT_CREATE_GVSV
" PERL_DONT_CREATE_GVSV"
# endif
# ifdef PERL_MALLOC_WRAP
" PERL_MALLOC_WRAP"
# endif
+# ifdef PERL_MEM_LOG
+ " PERL_MEM_LOG"
+# endif
+# ifdef PERL_MEM_LOG_ENV
+ " PERL_MEM_LOG_ENV"
+# endif
+# ifdef PERL_MEM_LOG_ENV_FD
+ " PERL_MEM_LOG_ENV_FD"
+# endif
+# ifdef PERL_MEM_LOG_STDERR
+ " PERL_MEM_LOG_STDERR"
+# endif
+# ifdef PERL_MEM_LOG_TIMESTAMP
+ " PERL_MEM_LOG_TIMESTAMP"
+# endif
# ifdef PERL_NEED_APPCTX
" PERL_NEED_APPCTX"
# endif
# ifdef PERL_OLD_COPY_ON_WRITE
" PERL_OLD_COPY_ON_WRITE"
# endif
+# ifdef PERL_POISON
+ " PERL_POISON"
+# endif
# ifdef PERL_TRACK_MEMPOOL
" PERL_TRACK_MEMPOOL"
# endif
# ifdef PERL_USE_SAFE_PUTENV
" PERL_USE_SAFE_PUTENV"
# endif
-#ifdef PERL_USES_PL_PIDSTATUS
+# ifdef PERL_USES_PL_PIDSTATUS
" PERL_USES_PL_PIDSTATUS"
-#endif
+# endif
# ifdef PL_OP_SLAB_ALLOC
" PL_OP_SLAB_ALLOC"
# endif
#ifdef USE_SITECUSTOMIZE
if (!minus_f) {
- if (!PL_preambleav)
- PL_preambleav = newAV();
- av_unshift(PL_preambleav, 1);
- (void)av_store(PL_preambleav, 0, Perl_newSVpvf(aTHX_ "BEGIN { do '%s/sitecustomize.pl' }", SITELIB_EXP));
+ (void)Perl_av_create_and_unshift_one(aTHX_ &PL_preambleav,
+ Perl_newSVpvf(aTHX_ "BEGIN { do '%s/sitecustomize.pl' }", SITELIB_EXP));
}
#endif
}
}
- PL_main_cv = PL_compcv = (CV*)newSV(0);
- sv_upgrade((SV *)PL_compcv, SVt_PVCV);
+ PL_main_cv = PL_compcv = (CV*)newSV_type(SVt_PVCV);
CvUNIQUE_on(PL_compcv);
CvPADLIST(PL_compcv) = pad_new(0);
boot_core_PerlIO();
boot_core_UNIVERSAL();
boot_core_xsutils();
+ boot_core_mro();
if (xsinit)
(*xsinit)(aTHX); /* in case linked C routines want magical variables */
return ret;
}
-
STATIC void
S_run_body(pTHX_ I32 oldscope)
{
sv_setiv(PL_DBsingle, 1);
if (PL_initav)
call_list(oldscope, PL_initav);
+#ifdef PERL_DEBUG_READONLY_OPS
+ Perl_pending_Slabs_to_ro(aTHX);
+#endif
}
/* do it */
Perl_get_cvn_flags(pTHX_ const char *name, STRLEN len, I32 flags)
{
GV* const gv = gv_fetchpvn_flags(name, len, flags, SVt_PVCV);
- /* XXX unsafe for threads if eval_owner isn't held */
/* XXX this is probably not what they think they're getting.
* It has the same effect as "sub name;", i.e. just a forward
* declaration! */
return s;
case 'A':
forbid_setid('A', -1);
- if (!PL_preambleav)
- PL_preambleav = newAV();
s++;
{
char * const start = s;
else if (*s != '\0') {
Perl_croak(aTHX_ "Can't use '%c' after -A%.*s", *s, (int)(s-start), start);
}
- av_push(PL_preambleav, sv);
+ Perl_av_create_and_push(aTHX_ &PL_preambleav, sv);
return s;
}
case 'M':
sv_catpvs(sv, "\0)");
}
s += strlen(s);
- if (!PL_preambleav)
- PL_preambleav = newAV();
- av_push(PL_preambleav, sv);
+ Perl_av_create_and_push(aTHX_ &PL_preambleav, sv);
}
else
Perl_croak(aTHX_ "Missing argument to -%c", *(s-1));
return s;
case 'v':
if (!sv_derived_from(PL_patchlevel, "version"))
- upg_version(PL_patchlevel);
+ upg_version(PL_patchlevel, TRUE);
#if !defined(DGUX)
PerlIO_printf(PerlIO_stdout(),
Perl_form(aTHX_ "\nThis is perl, %"SVf
SvREADONLY_on(gv);
PL_incgv = gv_HVadd(gv_AVadd(gv_fetchpvs("INC", GV_ADD|GV_NOTQUAL,
SVt_PVAV)));
- SvREFCNT_inc_simple(PL_incgv); /* Don't allow it to be freed */
+ SvREFCNT_inc_simple_void(PL_incgv); /* Don't allow it to be freed */
GvMULTI_on(PL_incgv);
PL_hintgv = gv_fetchpvs("\010", GV_ADD|GV_NOTQUAL, SVt_PV); /* ^H */
GvMULTI_on(PL_hintgv);
PL_defgv = gv_fetchpvs("_", GV_ADD|GV_NOTQUAL, SVt_PVAV);
- SvREFCNT_inc_simple(PL_defgv);
+ SvREFCNT_inc_simple_void(PL_defgv);
PL_errgv = gv_HVadd(gv_fetchpvs("@", GV_ADD|GV_NOTQUAL, SVt_PV));
- SvREFCNT_inc_simple(PL_errgv);
+ SvREFCNT_inc_simple_void(PL_errgv);
GvMULTI_on(PL_errgv);
PL_replgv = gv_fetchpvs("\022", GV_ADD|GV_NOTQUAL, SVt_PV); /* ^R */
GvMULTI_on(PL_replgv);
dVAR;
GV* tmpgv;
- PL_toptarget = newSV(0);
- sv_upgrade(PL_toptarget, SVt_PVFM);
+ PL_toptarget = newSV_type(SVt_PVFM);
sv_setpvn(PL_toptarget, "", 0);
- PL_bodytarget = newSV(0);
- sv_upgrade(PL_bodytarget, SVt_PVFM);
+ PL_bodytarget = newSV_type(SVt_PVFM);
sv_setpvn(PL_bodytarget, "", 0);
PL_formtarget = PL_bodytarget;
environ[0] = NULL;
}
if (env) {
- char** origenv = environ;
char *s;
SV *sv;
for (; *env; env++) {
(void)hv_store(hv, *env, s - *env, sv, 0);
if (env_is_not_environ)
mg_set(sv);
- if (origenv != environ) {
- /* realloc has shifted us */
- env = (env - origenv) + environ;
- origenv = environ;
- }
}
}
#endif /* USE_ENVIRON_ARRAY */
if (PL_minus_a) {
(void) get_av("main::F", TRUE | GV_ADDMULTI);
}
- /* touch @- and @+ arrays to prevent spurious warnings 20020415 MJD */
- (void) get_av("main::-", TRUE | GV_ADDMULTI);
- (void) get_av("main::+", TRUE | GV_ADDMULTI);
}
STATIC void
{
dVAR;
SV *atsv;
- const line_t oldline = CopLINE(PL_curcop);
+ volatile const line_t oldline = PL_curcop ? CopLINE(PL_curcop) : 0;
CV *cv;
STRLEN len;
int ret;
if (PL_savebegin) {
if (paramList == PL_beginav) {
/* save PL_beginav for compiler */
- if (! PL_beginav_save)
- PL_beginav_save = newAV();
- av_push(PL_beginav_save, (SV*)cv);
+ Perl_av_create_and_push(aTHX_ &PL_beginav_save, (SV*)cv);
}
else if (paramList == PL_checkav) {
/* save PL_checkav for compiler */
- if (! PL_checkav_save)
- PL_checkav_save = newAV();
- av_push(PL_checkav_save, (SV*)cv);
+ Perl_av_create_and_push(aTHX_ &PL_checkav_save, (SV*)cv);
}
else if (paramList == PL_unitcheckav) {
/* save PL_unitcheckav for compiler */
- if (! PL_unitcheckav_save)
- PL_unitcheckav_save = newAV();
- av_push(PL_unitcheckav_save, (SV*)cv);
+ Perl_av_create_and_push(aTHX_ &PL_unitcheckav_save, (SV*)cv);
}
} else {
if (!PL_madskills)
#endif
atsv = ERRSV;
(void)SvPV_const(atsv, len);
- if (PL_madskills && PL_minus_c && paramList == PL_beginav)
- break; /* not really trying to run, so just wing it */
if (len) {
PL_curcop = &PL_compiling;
CopLINE_set(PL_curcop, oldline);
PL_curcop = &PL_compiling;
CopLINE_set(PL_curcop, oldline);
JMPENV_POP;
- if (PL_madskills && PL_minus_c && paramList == PL_beginav)
- return; /* not really trying to run, so just wing it */
if (PL_statusvalue && !(PL_exit_flags & PERL_EXIT_EXPECTED)) {
if (paramList == PL_beginav)
Perl_croak(aTHX_ "BEGIN failed--compilation aborted");
https://perl5.git.perl.org / perl5.git / blobdiff