X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl.c;h=4dfea50763892f56faaf200446b871ba43b2b6de;hb=b9f83d2f7c4cb24d96302c6fcaa5e60628fad1f8;hp=88bbcbbd8017327e4844055b889bdefa91b3c582;hpb=780a5241a93925d81e932db73df46ee749b203b9;p=p5sagit%2Fp5-mst-13.2.git diff --git a/perl.c b/perl.c index 88bbcbb..4dfea50 100644 --- a/perl.c +++ b/perl.c @@ -171,7 +171,12 @@ S_init_tls_and_interp(PerlInterpreter *my_perl) 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); } } @@ -321,8 +326,8 @@ perl_construct(pTHXx) 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 @@ -1326,6 +1331,8 @@ Releases a Perl interpreter. See L. void perl_free(pTHXx) { + dVAR; + if (PL_veto_cleanup) return; @@ -1549,8 +1556,10 @@ setuid perl scripts securely.\n"); 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 && @@ -1582,6 +1591,8 @@ setuid perl scripts securely.\n"); } } } +#endif /* !defined(PERL_USE_SAFE_PUTENV) */ + PL_origalen = s ? s - PL_origargv[0] + 1 : 0; } @@ -1794,10 +1805,7 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit) { 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; @@ -2058,10 +2066,8 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit) #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 @@ -2127,8 +2133,7 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit) } } - 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); @@ -2495,7 +2500,6 @@ CV* 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! */ @@ -3180,8 +3184,6 @@ Perl_moreswitches(pTHX_ char *s) return s; case 'A': forbid_setid('A', -1); - if (!PL_preambleav) - PL_preambleav = newAV(); s++; { char * const start = s; @@ -3198,7 +3200,7 @@ Perl_moreswitches(pTHX_ char *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': @@ -3236,9 +3238,7 @@ Perl_moreswitches(pTHX_ char *s) 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)); @@ -4644,11 +4644,9 @@ S_init_postdump_symbols(pTHX_ register int argc, register char **argv, register 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; @@ -4690,7 +4688,6 @@ S_init_postdump_symbols(pTHX_ register int argc, register char **argv, register environ[0] = NULL; } if (env) { - char** origenv = environ; char *s; SV *sv; for (; *env; env++) { @@ -4705,11 +4702,6 @@ S_init_postdump_symbols(pTHX_ register int argc, register char **argv, register (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 */ @@ -5121,7 +5113,7 @@ Perl_call_list(pTHX_ I32 oldscope, AV *paramList) { dVAR; SV *atsv; - const line_t oldline = CopLINE(PL_curcop); + const line_t oldline = PL_curcop ? CopLINE(PL_curcop) : 0; CV *cv; STRLEN len; int ret; @@ -5132,21 +5124,15 @@ Perl_call_list(pTHX_ I32 oldscope, AV *paramList) 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)