struct IPerlProc* ipP)
{
PerlInterpreter *my_perl;
- /* New() needs interpreter, so call malloc() instead */
+ /* Newx() needs interpreter, so call malloc() instead */
my_perl = (PerlInterpreter*)(*ipM->pMalloc)(ipM, sizeof(PerlInterpreter));
S_init_tls_and_interp(my_perl);
Zero(my_perl, 1, PerlInterpreter);
{
PerlInterpreter *my_perl;
- /* New() needs interpreter, so call malloc() instead */
+ /* Newx() needs interpreter, so call malloc() instead */
my_perl = (PerlInterpreter*)PerlMem_malloc(sizeof(PerlInterpreter));
S_init_tls_and_interp(my_perl);
Safefree(PL_reg_start_tmp);
PL_reg_start_tmp = (char**)NULL;
PL_reg_start_tmpl = 0;
- if (PL_reg_curpm)
- Safefree(PL_reg_curpm);
+ Safefree(PL_reg_curpm);
Safefree(PL_reg_poscache);
free_tied_hv_pool();
Safefree(PL_op_mask);
s++;
goto reswitch;
case 'V':
- if (!PL_preambleav)
- PL_preambleav = newAV();
- av_push(PL_preambleav, newSVpv("use Config qw(myconfig config_vars)",0));
- if (*++s != ':') {
- STRLEN opts;
-
- PL_Sv = newSVpv("print myconfig();",0);
+ {
+ SV *opts_prog;
+
+ if (!PL_preambleav)
+ PL_preambleav = newAV();
+ av_push(PL_preambleav,
+ newSVpv("use Config;",0));
+ if (*++s != ':') {
+ STRLEN opts;
+
+ opts_prog = newSVpv("print Config::myconfig(),",0);
#ifdef VMS
- sv_catpv(PL_Sv,"print \"\\nCharacteristics of this PERLSHR image: \\n\",");
+ sv_catpv(opts_prog,"\"\\nCharacteristics of this PERLSHR image: \\n\",");
#else
- sv_catpv(PL_Sv,"print \"\\nCharacteristics of this binary (from libperl): \\n\",");
+ sv_catpv(opts_prog,"\"\\nCharacteristics of this binary (from libperl): \\n\",");
#endif
- opts = SvCUR(PL_Sv);
+ opts = SvCUR(opts_prog);
- sv_catpv(PL_Sv,"\" Compile-time options:");
+ sv_catpv(opts_prog,"\" Compile-time options:");
# ifdef DEBUGGING
- sv_catpv(PL_Sv," DEBUGGING");
+ sv_catpv(opts_prog," DEBUGGING");
# endif
# ifdef MULTIPLICITY
- sv_catpv(PL_Sv," MULTIPLICITY");
+ sv_catpv(opts_prog," MULTIPLICITY");
# endif
# ifdef USE_5005THREADS
- sv_catpv(PL_Sv," USE_5005THREADS");
+ sv_catpv(opts_prog," USE_5005THREADS");
# endif
# ifdef USE_ITHREADS
- sv_catpv(PL_Sv," USE_ITHREADS");
+ sv_catpv(opts_prog," USE_ITHREADS");
# endif
# ifdef USE_64_BIT_INT
- sv_catpv(PL_Sv," USE_64_BIT_INT");
+ sv_catpv(opts_prog," USE_64_BIT_INT");
# endif
# ifdef USE_64_BIT_ALL
- sv_catpv(PL_Sv," USE_64_BIT_ALL");
+ sv_catpv(opts_prog," USE_64_BIT_ALL");
# endif
# ifdef USE_LONG_DOUBLE
- sv_catpv(PL_Sv," USE_LONG_DOUBLE");
+ sv_catpv(opts_prog," USE_LONG_DOUBLE");
# endif
# ifdef USE_LARGE_FILES
- sv_catpv(PL_Sv," USE_LARGE_FILES");
+ sv_catpv(opts_prog," USE_LARGE_FILES");
# endif
# ifdef USE_SOCKS
- sv_catpv(PL_Sv," USE_SOCKS");
+ sv_catpv(opts_prog," USE_SOCKS");
# endif
# ifdef USE_SITECUSTOMIZE
- sv_catpv(PL_Sv," USE_SITECUSTOMIZE");
+ sv_catpv(opts_prog," USE_SITECUSTOMIZE");
# endif
# ifdef PERL_IMPLICIT_CONTEXT
- sv_catpv(PL_Sv," PERL_IMPLICIT_CONTEXT");
+ sv_catpv(opts_prog," PERL_IMPLICIT_CONTEXT");
# endif
# ifdef PERL_IMPLICIT_SYS
- sv_catpv(PL_Sv," PERL_IMPLICIT_SYS");
+ sv_catpv(opts_prog," PERL_IMPLICIT_SYS");
# endif
- while (SvCUR(PL_Sv) > opts+76) {
- /* find last space after "options: " and before col 76 */
+ while (SvCUR(opts_prog) > opts+76) {
+ /* find last space after "options: " and before col 76
+ */
- const char *space;
- char *pv = SvPV_nolen(PL_Sv);
- const char c = pv[opts+76];
- pv[opts+76] = '\0';
- space = strrchr(pv+opts+26, ' ');
- pv[opts+76] = c;
- if (!space) break; /* "Can't happen" */
+ const char *space;
+ char *pv = SvPV_nolen(opts_prog);
+ const char c = pv[opts+76];
+ pv[opts+76] = '\0';
+ space = strrchr(pv+opts+26, ' ');
+ pv[opts+76] = c;
+ if (!space) break; /* "Can't happen" */
- /* break the line before that space */
+ /* break the line before that space */
- opts = space - pv;
- sv_insert(PL_Sv, opts, 0,
- "\\n ", 25);
- }
+ opts = space - pv;
+ sv_insert(opts_prog, opts, 0,
+ "\\n ", 25);
+ }
- sv_catpv(PL_Sv,"\\n\",");
+ sv_catpv(opts_prog,"\\n\",");
#if defined(LOCAL_PATCH_COUNT)
- if (LOCAL_PATCH_COUNT > 0) {
- int i;
- sv_catpv(PL_Sv,"\" Locally applied patches:\\n\",");
- for (i = 1; i <= LOCAL_PATCH_COUNT; i++) {
- if (PL_localpatches[i])
- Perl_sv_catpvf(aTHX_ PL_Sv,"q%c\t%s\n%c,",
- 0, PL_localpatches[i], 0);
+ if (LOCAL_PATCH_COUNT > 0) {
+ int i;
+ sv_catpv(opts_prog,
+ "\" Locally applied patches:\\n\",");
+ for (i = 1; i <= LOCAL_PATCH_COUNT; i++) {
+ if (PL_localpatches[i])
+ Perl_sv_catpvf(aTHX_ opts_prog,"q%c\t%s\n%c,",
+ 0, PL_localpatches[i], 0);
+ }
}
- }
#endif
- Perl_sv_catpvf(aTHX_ PL_Sv,"\" Built under %s\\n\"",OSNAME);
+ Perl_sv_catpvf(aTHX_ opts_prog,
+ "\" Built under %s\\n\"",OSNAME);
#ifdef __DATE__
# ifdef __TIME__
- Perl_sv_catpvf(aTHX_ PL_Sv,",\" Compiled at %s %s\\n\"",__DATE__,__TIME__);
+ Perl_sv_catpvf(aTHX_ opts_prog,
+ ",\" Compiled at %s %s\\n\"",__DATE__,
+ __TIME__);
# else
- Perl_sv_catpvf(aTHX_ PL_Sv,",\" Compiled on %s\\n\"",__DATE__);
+ Perl_sv_catpvf(aTHX_ opts_prog,",\" Compiled on %s\\n\"",
+ __DATE__);
# endif
#endif
- sv_catpv(PL_Sv, "; \
-$\"=\"\\n \"; \
-@env = map { \"$_=\\\"$ENV{$_}\\\"\" } sort grep {/^PERL/} keys %ENV; ");
+ sv_catpv(opts_prog, "; $\"=\"\\n \"; "
+ "@env = map { \"$_=\\\"$ENV{$_}\\\"\" } "
+ "sort grep {/^PERL/} keys %ENV; ");
#ifdef __CYGWIN__
- sv_catpv(PL_Sv,"\
-push @env, \"CYGWIN=\\\"$ENV{CYGWIN}\\\"\";");
+ sv_catpv(opts_prog,
+ "push @env, \"CYGWIN=\\\"$ENV{CYGWIN}\\\"\";");
#endif
- sv_catpv(PL_Sv, "\
-print \" \\%ENV:\\n @env\\n\" if @env; \
-print \" \\@INC:\\n @INC\\n\";");
- }
- else {
- PL_Sv = newSVpv("config_vars(qw(",0);
- sv_catpv(PL_Sv, ++s);
- sv_catpv(PL_Sv, "))");
- s += strlen(s);
+ sv_catpv(opts_prog,
+ "print \" \\%ENV:\\n @env\\n\" if @env;"
+ "print \" \\@INC:\\n @INC\\n\";");
+ }
+ else {
+ ++s;
+ opts_prog = Perl_newSVpvf(aTHX_
+ "Config::config_vars(qw%c%s%c)",
+ 0, s, 0);
+ s += strlen(s);
+ }
+ av_push(PL_preambleav, opts_prog);
+ /* don't look for script or read stdin */
+ scriptname = BIT_BUCKET;
+ goto reswitch;
}
- av_push(PL_preambleav, PL_Sv);
- scriptname = BIT_BUCKET; /* don't look for script or read stdin */
- goto reswitch;
case 'x':
PL_doextract = TRUE;
s++;
CvPADLIST(PL_compcv) = pad_new(0);
#ifdef USE_5005THREADS
CvOWNER(PL_compcv) = 0;
- New(666, CvMUTEXP(PL_compcv), 1, perl_mutex);
+ Newx(CvMUTEXP(PL_compcv), 1, perl_mutex);
MUTEX_INIT(CvMUTEXP(PL_compcv));
#endif /* USE_5005THREADS */
HV*
Perl_get_hv(pTHX_ const char *name, I32 create)
{
- GV* gv = gv_fetchpv(name, create, SVt_PVHV);
+ GV* const gv = gv_fetchpv(name, create, SVt_PVHV);
if (create)
return GvHVn(gv);
if (gv)
dSP;
PUSHSTACKi(PERLSI_REQUIRE);
PUTBACK;
- sv = sv_newmortal();
- sv_setpv(sv, "require '");
- sv_catpv(sv, pv);
- sv_catpv(sv, "'");
- eval_sv(sv, G_DISCARD);
+ sv = Perl_newSVpvf(aTHX_ "require q%c%s%c", 0, pv, 0);
+ eval_sv(sv_2mortal(sv), G_DISCARD);
SPAGAIN;
POPSTACK;
}
sv_catpv(sv, start);
else {
sv_catpvn(sv, start, s-start);
- sv_catpv(sv, " split(/,/,q{");
- sv_catpv(sv, ++s);
- sv_catpv(sv, "})");
+ Perl_sv_catpvf(aTHX_ sv, " split(/,/,q%c%s%c)", 0, ++s, 0);
}
s += strlen(s);
- my_setenv("PERL5DB", SvPV(sv, PL_na));
+ my_setenv("PERL5DB", SvPV_nolen_const(sv));
}
if (!PL_perldb) {
PL_perldb = PERLDB_ALL;
usage(PL_origargv[0]);
my_exit(0);
case 'i':
- if (PL_inplace)
- Safefree(PL_inplace);
+ Safefree(PL_inplace);
#if defined(__CYGWIN__) /* do backup extension automagically */
if (*(s+1) == '\0') {
PL_inplace = savepv(".bak");
sv_catpvn(sv, start, s-start);
}
if (*s == '=') {
- sv_catpvn(sv, " split(/,/,q\0", 13);
- sv_catpv(sv, s+1);
- sv_catpvn(sv, "\0)", 2);
+ Perl_sv_catpvf(aTHX_ sv, " split(/,/,q%c%s%c)", 0, ++s, 0);
s+=strlen(s);
}
else if (*s != '\0') {
SV *sv;
const char *use = "use ";
/* -M-foo == 'no foo' */
- if (*s == '-') { use = "no "; ++s; }
- sv = newSVpv(use,0);
+ /* Leading space on " no " is deliberate, to make both
+ possibilities the same length. */
+ if (*s == '-') { use = " no "; ++s; }
+ sv = newSVpvn(use,4);
start = s;
/* We allow -M'Module qw(Foo Bar)' */
while(isALNUM(*s) || *s==':') ++s;
PL_stack_sp = PL_stack_base;
PL_stack_max = PL_stack_base + AvMAX(PL_curstack);
- New(50,PL_tmps_stack,REASONABLE(128),SV*);
+ Newx(PL_tmps_stack,REASONABLE(128),SV*);
PL_tmps_floor = -1;
PL_tmps_ix = -1;
PL_tmps_max = REASONABLE(128);
- New(54,PL_markstack,REASONABLE(32),I32);
+ Newx(PL_markstack,REASONABLE(32),I32);
PL_markstack_ptr = PL_markstack;
PL_markstack_max = PL_markstack + REASONABLE(32);
SET_MARK_OFFSET;
- New(54,PL_scopestack,REASONABLE(32),I32);
+ Newx(PL_scopestack,REASONABLE(32),I32);
PL_scopestack_ix = 0;
PL_scopestack_max = REASONABLE(32);
- New(54,PL_savestack,REASONABLE(128),ANY);
+ Newx(PL_savestack,REASONABLE(128),ANY);
PL_savestack_ix = 0;
PL_savestack_max = REASONABLE(128);
}
PL_statname = NEWSV(66,0); /* last filename we did stat on */
- if (PL_osname)
- Safefree(PL_osname);
+ Safefree(PL_osname);
PL_osname = savepv(OSNAME);
}
* The intent is that /usr/local/bin/perl and .../../lib/perl5
* generates /usr/local/lib/perl5
*/
- char *libpath = SvPVX(libdir);
+ const char *libpath = SvPVX(libdir);
STRLEN libpath_len = SvCUR(libdir);
if (libpath_len >= 4 && memEQ (libpath, ".../", 4)) {
/* Game on! */
- SV *caret_X = get_sv("\030", 0);
+ SV * const caret_X = get_sv("\030", 0);
/* Going to use the SV just as a scratch buffer holding a C
string: */
SV *prefix_sv;
#endif
XPV *xpv;
- Newz(53, thr, 1, struct perl_thread);
+ Newxz(thr, 1, struct perl_thread);
PL_curcop = &PL_compiling;
thr->interp = PERL_GET_INTERP;
thr->cvcache = newHV();
thr->flags = THRf_R_JOINABLE;
MUTEX_INIT(&thr->mutex);
/* Handcraft thrsv similarly to mess_sv */
- New(53, PL_thrsv, 1, SV);
- Newz(53, xpv, 1, XPV);
+ Newx(PL_thrsv, 1, SV);
+ Newxz(xpv, 1, XPV);
SvFLAGS(PL_thrsv) = SVt_PV;
SvANY(PL_thrsv) = (void*)xpv;
SvREFCNT(PL_thrsv) = 1 << 30; /* practically infinite */
projects / p5sagit/p5-mst-13.2.git / blobdiff