/* perl.c
*
- * Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999,
- * 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007 by Larry Wall and others
+ * Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000,
+ * 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 by Larry Wall and others
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
*/
/*
- * "A ship then new they built for him/of mithril and of elven glass" --Bilbo
+ * A ship then new they built for him
+ * of mithril and of elven-glass
+ * --from Bilbo's song of Eärendil
+ *
+ * [p.236 of _The Lord of the Rings_, II/i: "Many Meetings"]
*/
/* This file contains the top-level functions that are used to create, use
#define CALL_BODY_EVAL(myop) \
if (PL_op == (myop)) \
- PL_op = Perl_pp_entereval(aTHX); \
+ PL_op = PL_ppaddr[OP_ENTEREVAL](aTHX); \
if (PL_op) \
CALLRUNOPS(aTHX);
#define CALL_BODY_SUB(myop) \
if (PL_op == (myop)) \
- PL_op = Perl_pp_entersub(aTHX); \
+ PL_op = PL_ppaddr[OP_ENTERSUB](aTHX); \
if (PL_op) \
CALLRUNOPS(aTHX);
#define CALL_LIST_BODY(cv) \
PUSHMARK(PL_stack_sp); \
- call_sv((SV*)(cv), G_EVAL|G_DISCARD);
+ call_sv(MUTABLE_SV((cv)), G_EVAL|G_DISCARD);
static void
S_init_tls_and_interp(PerlInterpreter *my_perl)
PL_fdpid = newAV(); /* for remembering popen pids by fd */
PL_modglobal = newHV(); /* pointers to per-interpreter module globals */
PL_errors = newSVpvs("");
- sv_setpvn(PERL_DEBUG_PAD(0), "", 0); /* For regex debugging. */
- sv_setpvn(PERL_DEBUG_PAD(1), "", 0); /* ext/re needs these */
- sv_setpvn(PERL_DEBUG_PAD(2), "", 0); /* even without DEBUGGING. */
+ sv_setpvs(PERL_DEBUG_PAD(0), ""); /* For regex debugging. */
+ sv_setpvs(PERL_DEBUG_PAD(1), ""); /* ext/re needs these */
+ sv_setpvs(PERL_DEBUG_PAD(2), ""); /* even without DEBUGGING. */
#ifdef USE_ITHREADS
/* First entry is a list of empty elements. It needs to be initialised
else all hell breaks loose in S_find_uninit_var(). */
PL_timesbase.tms_cstime = 0;
#endif
+ PL_registered_mros = newHV();
+
ENTER;
}
int f;
const char *where;
/* Our success message is an integer 0, and a char 0 */
- static const char success[sizeof(int) + 1];
+ static const char success[sizeof(int) + 1] = {0};
close(fd[0]);
PL_exitlist = NULL;
PL_exitlistlen = 0;
+ SvREFCNT_dec(PL_registered_mros);
+
/* jettison our possibly duplicated environment */
/* if PERL_USE_SAFE_PUTENV is defined environ will not have been copied
* so we certainly shouldn't free it here
PL_regex_pad = NULL;
#endif
- SvREFCNT_dec((SV*) PL_stashcache);
+ SvREFCNT_dec(MUTABLE_SV(PL_stashcache));
PL_stashcache = NULL;
/* loosen bonds of global variables */
/* magical thingies */
- SvREFCNT_dec(PL_ofs_sv); /* $, */
- PL_ofs_sv = NULL;
+ SvREFCNT_dec(PL_ofsgv); /* *, */
+ PL_ofsgv = NULL;
SvREFCNT_dec(PL_ors_sv); /* $\ */
PL_ors_sv = NULL;
SV* sv;
register SV* svend;
- for (sva = PL_sv_arenaroot; sva; sva = (SV*)SvANY(sva)) {
+ for (sva = PL_sv_arenaroot; sva; sva = MUTABLE_SV(SvANY(sva))) {
svend = &sva[SvREFCNT(sva)];
for (sv = sva + 1; sv < svend; ++sv) {
if (SvTYPE(sv) != SVTYPEMASK) {
bool add_read_e_script = FALSE;
SvGROW(linestr_sv, 80);
- sv_setpvn(linestr_sv,"",0);
+ sv_setpvs(linestr_sv,"");
sv = newSVpvs(""); /* first used for -I flags */
SAVEFREESV(sv);
if (s && *s) {
STRLEN len = strlen(s);
const char * const p = savepvn(s, len);
- incpush(p, TRUE, TRUE, FALSE, FALSE);
+ incpush(p, TRUE, TRUE, FALSE, FALSE, FALSE);
sv_catpvs(sv, "-I");
sv_catpvn(sv, p, len);
sv_catpvs(sv, " ");
# ifdef PERL_MEM_LOG_TIMESTAMP
" PERL_MEM_LOG_TIMESTAMP"
# endif
+# ifdef PERL_USE_DEVEL
+ " PERL_USE_DEVEL"
+# endif
# ifdef PERL_USE_SAFE_PUTENV
" PERL_USE_SAFE_PUTENV"
# endif
# ifdef USE_SITECUSTOMIZE
" USE_SITECUSTOMIZE"
# endif
+# ifdef USE_FAST_STDIO
+ " USE_FAST_STDIO"
+# endif
, 0);
sv_catpv(opts_prog, PL_bincompat_options);
#else
sv_catpvs(opts_prog,"\"\\nCharacteristics of this binary (from libperl): \\n");
#endif
-
+ sv_catpvs(opts_prog," Source revision: " STRINGIFY(PERL_GIT_SHA1) "\\n");
sv_catpvs(opts_prog," Compile-time options: $_\\n\",");
#if defined(LOCAL_PATCH_COUNT)
"\" 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,",
+#ifdef X_PERL_PATCHNUM
+/* this is ifdef'ed out, we would enable this if we want to transform
+ "DEVEL" registered patches into the git name */
+ if (strEQ(PL_localpatches[i],"DEVEL"))
+ Perl_sv_catpvf(aTHX_ opts_prog,"q%c\t%s\n%c,",
+ 0, STRINGIFY(PERL_PATCHNUM), 0);
+ else
+#endif
+ Perl_sv_catpvf(aTHX_ opts_prog,"q%c\t%s\n%c,",
0, PL_localpatches[i], 0);
}
}
#endif
(s = PerlEnv_getenv("PERL5OPT")))
{
- const char *popt = s;
while (isSPACE(*s))
s++;
if (*s == '-' && *(s+1) == 'T') {
while (++s && *s) {
if (isSPACE(*s)) {
if (!popt_copy) {
- popt_copy = SvPVX(sv_2mortal(newSVpv(popt,0)));
- s = popt_copy + (s - popt);
- d = popt_copy + (d - popt);
+ popt_copy = SvPVX(sv_2mortal(newSVpv(d,0)));
+ s = popt_copy + (s - d);
+ d = popt_copy;
}
*s++ = '\0';
break;
}
}
- PL_main_cv = PL_compcv = (CV*)newSV_type(SVt_PVCV);
+ PL_main_cv = PL_compcv = MUTABLE_CV(newSV_type(SVt_PVCV));
CvUNIQUE_on(PL_compcv);
CvPADLIST(PL_compcv) = pad_new(0);
U32 out = PL_unicode & PERL_UNICODE_OUT_FLAG;
if (in) {
if (out)
- sv_setpvn(sv, ":utf8\0:utf8", 11);
+ sv_setpvs(sv, ":utf8\0:utf8");
else
- sv_setpvn(sv, ":utf8\0", 6);
+ sv_setpvs(sv, ":utf8\0");
}
else if (out)
- sv_setpvn(sv, "\0:utf8", 6);
+ sv_setpvs(sv, "\0:utf8");
SvSETMAGIC(sv);
}
}
{
PERL_ARGS_ASSERT_CALL_PV;
- return call_sv((SV*)get_cv(sub_name, TRUE), flags);
+ return call_sv(MUTABLE_SV(get_cv(sub_name, TRUE)), flags);
}
/*
&& (PL_DBcv || (PL_DBcv = GvCV(PL_DBsub)))
/* Try harder, since this may have been a sighandler, thus
* curstash may be meaningless. */
- && (SvTYPE(sv) != SVt_PVCV || CvSTASH((CV*)sv) != PL_debstash)
+ && (SvTYPE(sv) != SVt_PVCV || CvSTASH((const CV *)sv) != PL_debstash)
&& !(flags & G_NODEBUG))
PL_op->op_private |= OPpENTERSUB_DB;
redo_body:
CALL_BODY_SUB((OP*)&myop);
retval = PL_stack_sp - (PL_stack_base + oldmark);
- if (!(flags & G_KEEPERR))
- sv_setpvn(ERRSV,"",0);
+ if (!(flags & G_KEEPERR)) {
+ CLEAR_ERRSV();
+ }
break;
case 1:
STATUS_ALL_FAILURE;
redo_body:
CALL_BODY_EVAL((OP*)&myop);
retval = PL_stack_sp - (PL_stack_base + oldmark);
- if (!(flags & G_KEEPERR))
- sv_setpvn(ERRSV,"",0);
+ if (!(flags & G_KEEPERR)) {
+ CLEAR_ERRSV();
+ }
break;
case 1:
STATUS_ALL_FAILURE;
PUTBACK;
if (croak_on_error && SvTRUE(ERRSV)) {
- Perl_croak(aTHX_ SvPVx_nolen_const(ERRSV));
+ Perl_croak(aTHX_ "%s", SvPVx_nolen_const(ERRSV));
}
return sv;
POPSTACK;
}
-void
-Perl_magicname(pTHX_ const char *sym, const char *name, I32 namlen)
-{
- register GV * const gv = gv_fetchpv(sym, GV_ADD, SVt_PV);
-
- PERL_ARGS_ASSERT_MAGICNAME;
-
- if (gv)
- sv_magic(GvSV(gv), (SV*)gv, PERL_MAGIC_sv, name, namlen);
-}
-
STATIC void
S_usage(pTHX_ const char *name) /* XXX move this out into a module ? */
{
" o Method and overloading resolution",
" c String/numeric conversions",
" P Print profiling info, source file input state",
- " m Memory allocation",
+ " m Memory and SV allocation",
" f Format processing",
" r Regular expression parsing and execution",
" x Syntax tree dump",
p++;
} while (*p && *p != '-');
e = savepvn(s, e-s);
- incpush(e, TRUE, TRUE, FALSE, FALSE);
+ incpush(e, TRUE, TRUE, FALSE, FALSE, TRUE);
Safefree(e);
s = p;
if (*s == '-')
upg_version(PL_patchlevel, TRUE);
#if !defined(DGUX)
PerlIO_printf(PerlIO_stdout(),
- Perl_form(aTHX_ "\nThis is perl, %"SVf
-#ifdef PERL_PATCHNUM
- " DEVEL" STRINGIFY(PERL_PATCHNUM)
-#endif
- " built for %s",
- SVfARG(vstringify(PL_patchlevel)),
- ARCHNAME));
+ "\nThis is perl, %"SVf
+ " built for %s",
+ SVfARG(vstringify(PL_patchlevel)),
+ ARCHNAME);
#else /* DGUX */
/* Adjust verbose output as in the perl that ships with the DG/UX OS from EMC */
PerlIO_printf(PerlIO_stdout(),
Perl_form(aTHX_ " OS Specific Release: %s\n",
OSVERS));
#endif /* !DGUX */
-
+#if defined PERL_PATCHNUM
+ PerlIO_printf(PerlIO_stdout(),"\nCompiled from: %s",STRINGIFY(PERL_PATCHNUM));
+#endif
#if defined(LOCAL_PATCH_COUNT)
if (LOCAL_PATCH_COUNT > 0)
PerlIO_printf(PerlIO_stdout(),
#endif
PerlIO_printf(PerlIO_stdout(),
- "\n\nCopyright 1987-2007, Larry Wall\n");
+ "\n\nCopyright 1987-2008, Larry Wall\n");
#ifdef MACOS_TRADITIONAL
PerlIO_printf(PerlIO_stdout(),
"\nMac OS port Copyright 1991-2002, Matthias Neeracher;\n"
return s;
case '*':
case ' ':
- if (s[1] == '-') /* Additional switches on #! line. */
- return s+2;
+ while( *s == ' ' )
+ ++s;
+ if (s[0] == '-') /* Additional switches on #! line. */
+ return s+1;
break;
case '-':
case 0:
of the SvREFCNT_dec, only to add it again with hv_name_set */
SvREFCNT_dec(GvHV(gv));
hv_name_set(PL_defstash, "main", 4, 0);
- GvHV(gv) = (HV*)SvREFCNT_inc_simple(PL_defstash);
+ GvHV(gv) = MUTABLE_HV(SvREFCNT_inc_simple(PL_defstash));
SvREADONLY_on(gv);
PL_incgv = gv_HVadd(gv_AVadd(gv_fetchpvs("INC", GV_ADD|GV_NOTQUAL,
SVt_PVAV)));
gv_SVadd(PL_errgv);
#endif
sv_grow(ERRSV, 240); /* Preallocate - for immediate signals. */
- sv_setpvn(ERRSV, "", 0);
+ CLEAR_ERRSV();
PL_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,
SVt_PVHV));
/* We must init $/ before switches are processed. */
- sv_setpvn(get_sv("/", TRUE), "\n", 1);
+ sv_setpvs(get_sv("/", TRUE), "\n");
}
STATIC int
GV *tmpgv;
IO *io;
- sv_setpvn(get_sv("\"", TRUE), " ", 1);
+ sv_setpvs(get_sv("\"", TRUE), " ");
+ PL_ofsgv = (GV*)SvREFCNT_inc(gv_fetchpvs(",", GV_ADD|GV_NOTQUAL, SVt_PV));
+
PL_stdingv = gv_fetchpvs("STDIN", GV_ADD|GV_NOTQUAL, SVt_PVIO);
GvMULTI_on(PL_stdingv);
io = GvIOp(PL_stdingv);
IoIFP(io) = PerlIO_stdin();
tmpgv = gv_fetchpvs("stdin", GV_ADD|GV_NOTQUAL, SVt_PV);
GvMULTI_on(tmpgv);
- GvIOp(tmpgv) = (IO*)SvREFCNT_inc_simple(io);
+ GvIOp(tmpgv) = MUTABLE_IO(SvREFCNT_inc_simple(io));
tmpgv = gv_fetchpvs("STDOUT", GV_ADD|GV_NOTQUAL, SVt_PVIO);
GvMULTI_on(tmpgv);
setdefout(tmpgv);
tmpgv = gv_fetchpvs("stdout", GV_ADD|GV_NOTQUAL, SVt_PV);
GvMULTI_on(tmpgv);
- GvIOp(tmpgv) = (IO*)SvREFCNT_inc_simple(io);
+ GvIOp(tmpgv) = MUTABLE_IO(SvREFCNT_inc_simple(io));
PL_stderrgv = gv_fetchpvs("STDERR", GV_ADD|GV_NOTQUAL, SVt_PVIO);
GvMULTI_on(PL_stderrgv);
IoOFP(io) = IoIFP(io) = PerlIO_stderr();
tmpgv = gv_fetchpvs("stderr", GV_ADD|GV_NOTQUAL, SVt_PV);
GvMULTI_on(tmpgv);
- GvIOp(tmpgv) = (IO*)SvREFCNT_inc_simple(io);
+ GvIOp(tmpgv) = MUTABLE_IO(SvREFCNT_inc_simple(io));
PL_statname = newSV(0); /* last filename we did stat on */
PERL_ARGS_ASSERT_INIT_POSTDUMP_SYMBOLS;
PL_toptarget = newSV_type(SVt_PVFM);
- sv_setpvn(PL_toptarget, "", 0);
+ sv_setpvs(PL_toptarget, "");
PL_bodytarget = newSV_type(SVt_PVFM);
- sv_setpvn(PL_bodytarget, "", 0);
+ sv_setpvs(PL_bodytarget, "");
PL_formtarget = PL_bodytarget;
TAINT;
sv_setpv(GvSV(tmpgv),MacPerl_MPWFileName(PL_origfilename));
#else
sv_setpv(GvSV(tmpgv),PL_origfilename);
- magicname("0", "0", 1);
+ {
+ GV * const gv = gv_fetchpv("0", GV_ADD, SVt_PV);
+ if (gv)
+ sv_magic(GvSV(gv), MUTABLE_SV(gv), PERL_MAGIC_sv, "0", 1);
+ }
#endif
}
if ((PL_envgv = gv_fetchpvs("ENV", GV_ADD|GV_NOTQUAL, SVt_PVHV))) {
environ[0] = NULL;
}
if (env) {
- char *s;
+ char *s, *old_var;
SV *sv;
for (; *env; env++) {
- if (!(s = strchr(*env,'=')) || s == *env)
+ old_var = *env;
+
+ if (!(s = strchr(old_var,'=')) || s == old_var)
continue;
+
#if defined(MSDOS) && !defined(DJGPP)
*s = '\0';
- (void)strupr(*env);
+ (void)strupr(old_var);
*s = '=';
#endif
sv = newSVpv(s+1, 0);
- (void)hv_store(hv, *env, s - *env, sv, 0);
+ (void)hv_store(hv, old_var, s - old_var, sv, 0);
if (env_is_not_environ)
mg_set(sv);
}
#else
if (s)
#endif
- incpush(s, TRUE, TRUE, TRUE, FALSE);
+ incpush(s, TRUE, TRUE, TRUE, FALSE, FALSE);
else
- incpush(PerlEnv_getenv("PERLLIB"), FALSE, FALSE, TRUE, FALSE);
+ incpush(PerlEnv_getenv("PERLLIB"), FALSE, FALSE, TRUE, FALSE, FALSE);
#else /* VMS */
/* Treat PERL5?LIB as a possible search list logical name -- the
* "natural" VMS idiom for a Unix path string. We allow each
char buf[256];
int idx = 0;
if (my_trnlnm("PERL5LIB",buf,0))
- do { incpush(buf,TRUE,TRUE,TRUE,FALSE); } while (my_trnlnm("PERL5LIB",buf,++idx));
+ do { incpush(buf,TRUE,TRUE,TRUE,FALSE, FALSE); } while (my_trnlnm("PERL5LIB",buf,++idx));
else
- while (my_trnlnm("PERLLIB",buf,idx++)) incpush(buf,FALSE,FALSE,TRUE,FALSE);
+ while (my_trnlnm("PERLLIB",buf,idx++)) incpush(buf,FALSE,FALSE,TRUE,FALSE, FALSE);
#endif /* VMS */
}
ARCHLIB PRIVLIB SITEARCH SITELIB VENDORARCH and VENDORLIB
*/
#ifdef APPLLIB_EXP
- incpush(APPLLIB_EXP, TRUE, TRUE, TRUE, TRUE);
+ incpush(APPLLIB_EXP, TRUE, TRUE, TRUE, TRUE, FALSE);
#endif
#ifdef ARCHLIB_EXP
- incpush(ARCHLIB_EXP, FALSE, FALSE, TRUE, TRUE);
+ incpush(ARCHLIB_EXP, FALSE, FALSE, TRUE, TRUE, FALSE);
#endif
#ifdef MACOS_TRADITIONAL
{
Perl_sv_setpvf(aTHX_ privdir, "%slib:", macperl);
if (PerlLIO_stat(SvPVX(privdir), &tmpstatbuf) >= 0 && S_ISDIR(tmpstatbuf.st_mode))
- incpush(SvPVX(privdir), TRUE, FALSE, TRUE, FALSE);
+ incpush(SvPVX(privdir), TRUE, FALSE, TRUE, FALSE, FALSE);
Perl_sv_setpvf(aTHX_ privdir, "%ssite_perl:", macperl);
if (PerlLIO_stat(SvPVX(privdir), &tmpstatbuf) >= 0 && S_ISDIR(tmpstatbuf.st_mode))
- incpush(SvPVX(privdir), TRUE, FALSE, TRUE, FALSE);
+ incpush(SvPVX(privdir), TRUE, FALSE, TRUE, FALSE, FALSE);
SvREFCNT_dec(privdir);
}
if (!PL_tainting)
- incpush(":", FALSE, FALSE, TRUE, FALSE);
+ incpush(":", FALSE, FALSE, FALSE, FALSE, FALSE);
#else
#ifndef PRIVLIB_EXP
# define PRIVLIB_EXP "/usr/local/lib/perl5:/usr/local/lib/perl"
#endif
#if defined(WIN32)
- incpush(PRIVLIB_EXP, TRUE, FALSE, TRUE, TRUE);
+ incpush(PRIVLIB_EXP, TRUE, FALSE, TRUE, TRUE, FALSE);
#else
- incpush(PRIVLIB_EXP, FALSE, FALSE, TRUE, TRUE);
+ incpush(PRIVLIB_EXP, FALSE, FALSE, TRUE, TRUE, FALSE);
#endif
#ifdef SITEARCH_EXP
/* sitearch is always relative to sitelib on Windows for
* DLL-based path intuition to work correctly */
# if !defined(WIN32)
- incpush(SITEARCH_EXP, FALSE, FALSE, TRUE, TRUE);
+ incpush(SITEARCH_EXP, FALSE, FALSE, TRUE, TRUE, FALSE);
# endif
#endif
#ifdef SITELIB_EXP
# if defined(WIN32)
/* this picks up sitearch as well */
- incpush(SITELIB_EXP, TRUE, FALSE, TRUE, TRUE);
+ incpush(SITELIB_EXP, TRUE, FALSE, TRUE, TRUE, FALSE);
# else
- incpush(SITELIB_EXP, FALSE, FALSE, TRUE, TRUE);
+ incpush(SITELIB_EXP, FALSE, FALSE, TRUE, TRUE, FALSE);
# endif
#endif
#if defined(SITELIB_STEM) && defined(PERL_INC_VERSION_LIST)
/* Search for version-specific dirs below here */
- incpush(SITELIB_STEM, FALSE, TRUE, TRUE, TRUE);
+ incpush(SITELIB_STEM, FALSE, TRUE, TRUE, TRUE, FALSE);
#endif
#ifdef PERL_VENDORARCH_EXP
/* vendorarch is always relative to vendorlib on Windows for
* DLL-based path intuition to work correctly */
# if !defined(WIN32)
- incpush(PERL_VENDORARCH_EXP, FALSE, FALSE, TRUE, TRUE);
+ incpush(PERL_VENDORARCH_EXP, FALSE, FALSE, TRUE, TRUE, FALSE);
# endif
#endif
#ifdef PERL_VENDORLIB_EXP
# if defined(WIN32)
- incpush(PERL_VENDORLIB_EXP, TRUE, FALSE, TRUE, TRUE); /* this picks up vendorarch as well */
+ incpush(PERL_VENDORLIB_EXP, TRUE, FALSE, TRUE, TRUE, FALSE); /* this picks up vendorarch as well */
# else
- incpush(PERL_VENDORLIB_EXP, FALSE, FALSE, TRUE, TRUE);
+ incpush(PERL_VENDORLIB_EXP, FALSE, FALSE, TRUE, TRUE, FALSE);
# endif
#endif
-#ifdef PERL_VENDORLIB_STEM /* Search for version-specific dirs below here */
- incpush(PERL_VENDORLIB_STEM, FALSE, TRUE, TRUE, TRUE);
+#if defined(PERL_VENDORLIB_STEM) && defined(PERL_INC_VERSION_LIST)
+ /* Search for version-specific dirs below here */
+ incpush(PERL_VENDORLIB_STEM, FALSE, TRUE, TRUE, TRUE, FALSE);
#endif
#ifdef PERL_OTHERLIBDIRS
- incpush(PERL_OTHERLIBDIRS, TRUE, TRUE, TRUE, TRUE);
+ incpush(PERL_OTHERLIBDIRS, TRUE, TRUE, TRUE, TRUE, FALSE);
#endif
if (!PL_tainting)
- incpush(".", FALSE, FALSE, TRUE, FALSE);
+ incpush(".", FALSE, FALSE, FALSE, FALSE, FALSE);
#endif /* MACOS_TRADITIONAL */
}
STATIC void
S_incpush(pTHX_ const char *dir, bool addsubdirs, bool addoldvers, bool usesep,
- bool canrelocate)
+ bool canrelocate, bool unshift)
{
dVAR;
SV *subdir = NULL;
#endif
}
- /* finally push this lib directory on the end of @INC */
- av_push(GvAVn(PL_incgv), libdir);
+ /* finally add this lib directory at the end of @INC */
+ if (unshift) {
+ av_unshift( GvAVn( PL_incgv ), 1 );
+ av_store( GvAVn( PL_incgv ), 0, libdir );
+ }
+ else {
+ av_push(GvAVn(PL_incgv), libdir);
+ }
}
if (subdir) {
assert (SvREFCNT(subdir) == 1);
PERL_ARGS_ASSERT_CALL_LIST;
while (av_len(paramList) >= 0) {
- cv = (CV*)av_shift(paramList);
+ cv = MUTABLE_CV(av_shift(paramList));
if (PL_savebegin) {
if (paramList == PL_beginav) {
/* save PL_beginav for compiler */
- Perl_av_create_and_push(aTHX_ &PL_beginav_save, (SV*)cv);
+ Perl_av_create_and_push(aTHX_ &PL_beginav_save, MUTABLE_SV(cv));
}
else if (paramList == PL_checkav) {
/* save PL_checkav for compiler */
- Perl_av_create_and_push(aTHX_ &PL_checkav_save, (SV*)cv);
+ Perl_av_create_and_push(aTHX_ &PL_checkav_save, MUTABLE_SV(cv));
}
else if (paramList == PL_unitcheckav) {
/* save PL_unitcheckav for compiler */
- Perl_av_create_and_push(aTHX_ &PL_unitcheckav_save, (SV*)cv);
+ Perl_av_create_and_push(aTHX_ &PL_unitcheckav_save, MUTABLE_SV(cv));
}
} else {
if (!PL_madskills)
projects / p5sagit/p5-mst-13.2.git / blobdiff