#define perl_free Perl_free
#endif
+#if defined(USE_THREADS)
+# define INIT_TLS_AND_INTERP \
+ STMT_START { \
+ if (!PL_curinterp) { \
+ PERL_SET_INTERP(my_perl); \
+ INIT_THREADS; \
+ ALLOC_THREAD_KEY; \
+ } \
+ } STMT_END
+#else
+# if defined(USE_ITHREADS)
+# define INIT_TLS_AND_INTERP \
+ STMT_START { \
+ if (!PL_curinterp) { \
+ PERL_SET_INTERP(my_perl); \
+ INIT_THREADS; \
+ ALLOC_THREAD_KEY; \
+ PERL_SET_THX(my_perl); \
+ OP_REFCNT_INIT; \
+ } \
+ else { \
+ PERL_SET_THX(my_perl); \
+ } \
+ } STMT_END
+# else
+# define INIT_TLS_AND_INTERP \
+ STMT_START { \
+ if (!PL_curinterp) { \
+ PERL_SET_INTERP(my_perl); \
+ } \
+ PERL_SET_THX(my_perl); \
+ } STMT_END
+# endif
+#endif
+
#ifdef PERL_IMPLICIT_SYS
PerlInterpreter *
perl_alloc_using(struct IPerlMem* ipM, struct IPerlMem* ipMS,
#ifdef PERL_OBJECT
my_perl = (PerlInterpreter*)new(ipM) CPerlObj(ipM, ipMS, ipMP, ipE, ipStd,
ipLIO, ipD, ipS, ipP);
- if (!PL_curinterp) {
- PERL_SET_INTERP(my_perl);
-#if defined(USE_THREADS) || defined(USE_ITHREADS)
- INIT_THREADS;
- ALLOC_THREAD_KEY;
-#endif
- }
- PERL_SET_THX(my_perl);
+ INIT_TLS_AND_INTERP;
#else
/* New() needs interpreter, so call malloc() instead */
my_perl = (PerlInterpreter*)(*ipM->pMalloc)(ipM, sizeof(PerlInterpreter));
- if (!PL_curinterp) {
- PERL_SET_INTERP(my_perl);
-#if defined(USE_THREADS) || defined(USE_ITHREADS)
- INIT_THREADS;
- ALLOC_THREAD_KEY;
-#endif
- }
- PERL_SET_THX(my_perl);
+ INIT_TLS_AND_INTERP;
Zero(my_perl, 1, PerlInterpreter);
PL_Mem = ipM;
PL_MemShared = ipMS;
/* New() needs interpreter, so call malloc() instead */
my_perl = (PerlInterpreter*)PerlMem_malloc(sizeof(PerlInterpreter));
- if (!PL_curinterp) {
- PERL_SET_INTERP(my_perl);
-#if defined(USE_THREADS) || defined(USE_ITHREADS)
- INIT_THREADS;
- ALLOC_THREAD_KEY;
-#endif
- }
- PERL_SET_THX(my_perl);
+ INIT_TLS_AND_INTERP;
Zero(my_perl, 1, PerlInterpreter);
return my_perl;
}
{
U8 *s;
PL_patchlevel = NEWSV(0,4);
- SvUPGRADE(PL_patchlevel, SVt_PVNV);
+ (void)SvUPGRADE(PL_patchlevel, SVt_PVNV);
if (PERL_REVISION > 127 || PERL_VERSION > 127 || PERL_SUBVERSION > 127)
SvGROW(PL_patchlevel, UTF8_MAXLEN*3+1);
s = (U8*)SvPVX(PL_patchlevel);
#ifdef DEBUGGING
{
char *s;
- if (s = PerlEnv_getenv("PERL_DESTRUCT_LEVEL")) {
+ if ((s = PerlEnv_getenv("PERL_DESTRUCT_LEVEL"))) {
int i = atoi(s);
if (destruct_level < i)
destruct_level = i;
if (!specialWARN(PL_compiling.cop_warnings))
SvREFCNT_dec(PL_compiling.cop_warnings);
PL_compiling.cop_warnings = Nullsv;
+#ifndef USE_ITHREADS
+ SvREFCNT_dec(CopFILEGV(&PL_compiling));
+ CopFILEGV_set(&PL_compiling, Nullgv);
+#endif
/* Prepare to destruct main symbol table. */
SvREFCNT(&PL_sv_yes) = 0;
sv_clear(&PL_sv_yes);
SvANY(&PL_sv_yes) = NULL;
+ SvREADONLY_off(&PL_sv_yes);
SvREFCNT(&PL_sv_no) = 0;
sv_clear(&PL_sv_no);
SvANY(&PL_sv_no) = NULL;
+ SvREADONLY_off(&PL_sv_no);
+
+ SvREFCNT(&PL_sv_undef) = 0;
+ SvREADONLY_off(&PL_sv_undef);
if (PL_sv_count != 0 && ckWARN_d(WARN_INTERNAL))
Perl_warner(aTHX_ WARN_INTERNAL,"Scalars leaked: %ld\n", (long)PL_sv_count);
}
}
/* we know that type >= SVt_PV */
- SvOOK_off(PL_mess_sv);
+ (void)SvOOK_off(PL_mess_sv);
Safefree(SvPVX(PL_mess_sv));
Safefree(SvANY(PL_mess_sv));
Safefree(PL_mess_sv);
s = argv[0]+1;
reswitch:
switch (*s) {
+ case 'C':
+#ifdef WIN32
+ win32_argv2utf8(argc-1, argv+1);
+ /* FALL THROUGH */
+#endif
#ifndef PERL_STRICT_CR
case '\r':
#endif
case ' ':
case '0':
- case 'C':
case 'F':
case 'a':
case 'c':
case 'W':
case 'X':
case 'w':
- if (s = moreswitches(s))
+ if ((s = moreswitches(s)))
goto reswitch;
break;
char *p;
STRLEN len = strlen(s);
p = savepvn(s, len);
- incpush(p, TRUE);
+ incpush(p, TRUE, TRUE);
sv_catpvn(sv, "-I", 2);
sv_catpvn(sv, p, len);
sv_catpvn(sv, " ", 1);
{
register GV *gv;
- if (gv = gv_fetchpv(sym,TRUE, SVt_PV))
+ if ((gv = gv_fetchpv(sym,TRUE, SVt_PV)))
sv_magic(GvSV(gv), (SV*)gv, 0, name, namlen);
}
p++;
} while (*p && *p != '-');
e = savepvn(s, e-s);
- incpush(e, TRUE);
+ incpush(e, TRUE, TRUE);
Safefree(e);
s = p;
if (*s == '-')
S_open_script(pTHX_ char *scriptname, bool dosearch, SV *sv, int *fdscript)
{
dTHR;
- register char *s;
*fdscript = -1;
STATIC void
S_validate_suid(pTHX_ char *validarg, char *scriptname, int fdscript)
{
+#ifdef IAMSUID
int which;
+#endif
/* do we need to emulate setuid on scripts? */
while (isDIGIT(s2[-1]) || strchr("-._", s2[-1])) s2--;
if (strnEQ(s2-4,"perl",4))
/*SUPPRESS 530*/
- while (s = moreswitches(s)) ;
+ while ((s = moreswitches(s)))
+ ;
}
}
}
{
dTHR;
GV *tmpgv;
- GV *othergv;
IO *io;
sv_setpvn(get_sv("\"", TRUE), " ", 1);
argc--,argv++;
break;
}
- if (s = strchr(argv[0], '=')) {
+ if ((s = strchr(argv[0], '='))) {
*s++ = '\0';
sv_setpv(GvSV(gv_fetchpv(argv[0]+1,TRUE, SVt_PV)),s);
}
PL_formtarget = PL_bodytarget;
TAINT;
- if (tmpgv = gv_fetchpv("0",TRUE, SVt_PV)) {
+ if ((tmpgv = gv_fetchpv("0",TRUE, SVt_PV))) {
sv_setpv(GvSV(tmpgv),PL_origfilename);
magicname("0", "0", 1);
}
- if (tmpgv = gv_fetchpv("\030",TRUE, SVt_PV))
+ if ((tmpgv = gv_fetchpv("\030",TRUE, SVt_PV)))
#ifdef OS2
sv_setpv(GvSV(tmpgv), os2_execname());
#else
sv_setpv(GvSV(tmpgv),PL_origargv[0]);
#endif
- if (PL_argvgv = gv_fetchpv("ARGV",TRUE, SVt_PVAV)) {
+ if ((PL_argvgv = gv_fetchpv("ARGV",TRUE, SVt_PVAV))) {
GvMULTI_on(PL_argvgv);
(void)gv_AVadd(PL_argvgv);
av_clear(GvAVn(PL_argvgv));
for (; argc > 0; argc--,argv++) {
- av_push(GvAVn(PL_argvgv),newSVpv(argv[0],0));
+ SV *sv = newSVpv(argv[0],0);
+ av_push(GvAVn(PL_argvgv),sv);
+ if (PL_widesyscalls)
+ sv_utf8_upgrade(sv);
}
}
- if (PL_envgv = gv_fetchpv("ENV",TRUE, SVt_PVHV)) {
+ if ((PL_envgv = gv_fetchpv("ENV",TRUE, SVt_PVHV))) {
HV *hv;
GvMULTI_on(PL_envgv);
hv = GvHVn(PL_envgv);
#endif
}
TAINT_NOT;
- if (tmpgv = gv_fetchpv("$",TRUE, SVt_PV))
+ if ((tmpgv = gv_fetchpv("$",TRUE, SVt_PV)))
sv_setiv(GvSV(tmpgv), (IV)PerlProc_getpid());
}
#ifndef VMS
s = PerlEnv_getenv("PERL5LIB");
if (s)
- incpush(s, TRUE);
+ incpush(s, TRUE, TRUE);
else
- incpush(PerlEnv_getenv("PERLLIB"), FALSE);
+ incpush(PerlEnv_getenv("PERLLIB"), 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); } while (my_trnlnm("PERL5LIB",buf,++idx));
+ do { incpush(buf,TRUE,TRUE); } while (my_trnlnm("PERL5LIB",buf,++idx));
else
- while (my_trnlnm("PERLLIB",buf,idx++)) incpush(buf,FALSE);
+ while (my_trnlnm("PERLLIB",buf,idx++)) incpush(buf,FALSE,FALSE);
#endif /* VMS */
}
/* Use the ~-expanded versions of APPLLIB (undocumented),
- ARCHLIB PRIVLIB SITEARCH and SITELIB
+ ARCHLIB PRIVLIB SITEARCH SITELIB VENDORARCH and VENDORLIB
*/
#ifdef APPLLIB_EXP
- incpush(APPLLIB_EXP, TRUE);
+ incpush(APPLLIB_EXP, TRUE, TRUE);
#endif
#ifdef ARCHLIB_EXP
- incpush(ARCHLIB_EXP, FALSE);
+ incpush(ARCHLIB_EXP, FALSE, FALSE);
#endif
#ifndef PRIVLIB_EXP
-#define PRIVLIB_EXP "/usr/local/lib/perl5:/usr/local/lib/perl"
+# define PRIVLIB_EXP "/usr/local/lib/perl5:/usr/local/lib/perl"
#endif
#if defined(WIN32)
- incpush(PRIVLIB_EXP, TRUE);
+ incpush(PRIVLIB_EXP, TRUE, FALSE);
#else
- incpush(PRIVLIB_EXP, FALSE);
+ incpush(PRIVLIB_EXP, FALSE, 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);
+# endif
#endif
-#if defined(WIN32)
- incpush(SITELIB_EXP, TRUE); /* XXX Win32 needs inc_version_list support */
-#else
#ifdef SITELIB_EXP
- {
- char *path = SITELIB_EXP;
-
- if (path) {
- char buf[1024];
- strcpy(buf,path);
- if (strrchr(buf,'/')) /* XXX Hack, Configure var needed */
- *strrchr(buf,'/') = '\0';
- incpush(buf, TRUE);
- }
- }
+# if defined(WIN32)
+ incpush(SITELIB_EXP, TRUE, FALSE); /* this picks up sitearch as well */
+# else
+ incpush(SITELIB_EXP, FALSE, FALSE);
+# endif
#endif
+
+#ifdef SITELIB_STEM /* Search for version-specific dirs below here */
+ incpush(SITELIB_STEM, FALSE, TRUE);
#endif
-#if defined(PERL_VENDORLIB_EXP)
-#if defined(WIN32)
- incpush(PERL_VENDORLIB_EXP, TRUE);
-#else
- incpush(PERL_VENDORLIB_EXP, FALSE);
+
+#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);
+# endif
+#endif
+
+#ifdef PERL_VENDORLIB_EXP
+# if defined(WIN32)
+ incpush(PERL_VENDORLIB_EXP, TRUE, FALSE); /* this picks up vendorarch as well */
+# else
+ incpush(PERL_VENDORLIB_EXP, FALSE, FALSE);
+# endif
#endif
+
+#ifdef PERL_VENDORLIB_STEM /* Search for version-specific dirs below here */
+ incpush(PERL_VENDORLIB_STEM, FALSE, TRUE);
#endif
+
if (!PL_tainting)
- incpush(".", FALSE);
+ incpush(".", FALSE, FALSE);
}
#if defined(DOSISH)
#endif
STATIC void
-S_incpush(pTHX_ char *p, int addsubdirs)
+S_incpush(pTHX_ char *p, int addsubdirs, int addoldvers)
{
SV *subdir = Nullsv;
- if (!p)
+ if (!p || !*p)
return;
- if (addsubdirs) {
+ if (addsubdirs || addoldvers) {
subdir = sv_newmortal();
}
* BEFORE pushing libdir onto @INC we may first push version- and
* archname-specific sub-directories.
*/
- if (addsubdirs) {
+ if (addsubdirs || addoldvers) {
#ifdef PERL_INC_VERSION_LIST
/* Configure terminates PERL_INC_VERSION_LIST with a NULL */
const char *incverlist[] = { PERL_INC_VERSION_LIST };
"Failed to unixify @INC element \"%s\"\n",
SvPV(libdir,len));
#endif
- /* .../version/archname if -d .../version/archname */
- Perl_sv_setpvf(aTHX_ subdir, "%"SVf"/"PERL_FS_VER_FMT"/%s", libdir,
- (int)PERL_REVISION, (int)PERL_VERSION,
- (int)PERL_SUBVERSION, ARCHNAME);
- if (PerlLIO_stat(SvPVX(subdir), &tmpstatbuf) >= 0 &&
- S_ISDIR(tmpstatbuf.st_mode))
- av_push(GvAVn(PL_incgv), newSVsv(subdir));
-
- /* .../version if -d .../version */
- Perl_sv_setpvf(aTHX_ subdir, "%"SVf"/"PERL_FS_VER_FMT, libdir,
- (int)PERL_REVISION, (int)PERL_VERSION,
- (int)PERL_SUBVERSION);
- if (PerlLIO_stat(SvPVX(subdir), &tmpstatbuf) >= 0 &&
- S_ISDIR(tmpstatbuf.st_mode))
- av_push(GvAVn(PL_incgv), newSVsv(subdir));
-
- /* .../archname if -d .../archname */
- Perl_sv_setpvf(aTHX_ subdir, "%"SVf"/%s", libdir, ARCHNAME);
- if (PerlLIO_stat(SvPVX(subdir), &tmpstatbuf) >= 0 &&
- S_ISDIR(tmpstatbuf.st_mode))
- av_push(GvAVn(PL_incgv), newSVsv(subdir));
+ if (addsubdirs) {
+ /* .../version/archname if -d .../version/archname */
+ Perl_sv_setpvf(aTHX_ subdir, "%"SVf"/"PERL_FS_VER_FMT"/%s",
+ libdir,
+ (int)PERL_REVISION, (int)PERL_VERSION,
+ (int)PERL_SUBVERSION, ARCHNAME);
+ if (PerlLIO_stat(SvPVX(subdir), &tmpstatbuf) >= 0 &&
+ S_ISDIR(tmpstatbuf.st_mode))
+ av_push(GvAVn(PL_incgv), newSVsv(subdir));
-#ifdef PERL_INC_VERSION_LIST
- for (incver = incverlist; *incver; incver++) {
- /* .../xxx if -d .../xxx */
- Perl_sv_setpvf(aTHX_ subdir, "%"SVf"/%s", libdir, *incver);
+ /* .../version if -d .../version */
+ Perl_sv_setpvf(aTHX_ subdir, "%"SVf"/"PERL_FS_VER_FMT, libdir,
+ (int)PERL_REVISION, (int)PERL_VERSION,
+ (int)PERL_SUBVERSION);
if (PerlLIO_stat(SvPVX(subdir), &tmpstatbuf) >= 0 &&
S_ISDIR(tmpstatbuf.st_mode))
av_push(GvAVn(PL_incgv), newSVsv(subdir));
+
+ /* .../archname if -d .../archname */
+ Perl_sv_setpvf(aTHX_ subdir, "%"SVf"/%s", libdir, ARCHNAME);
+ if (PerlLIO_stat(SvPVX(subdir), &tmpstatbuf) >= 0 &&
+ S_ISDIR(tmpstatbuf.st_mode))
+ av_push(GvAVn(PL_incgv), newSVsv(subdir));
+ }
+
+ if (addoldvers) {
+#ifdef PERL_INC_VERSION_LIST
+ for (incver = incverlist; *incver; incver++) {
+ /* .../xxx if -d .../xxx */
+ Perl_sv_setpvf(aTHX_ subdir, "%"SVf"/%s", libdir, *incver);
+ if (PerlLIO_stat(SvPVX(subdir), &tmpstatbuf) >= 0 &&
+ S_ISDIR(tmpstatbuf.st_mode))
+ av_push(GvAVn(PL_incgv), newSVsv(subdir));
+ }
}
#endif
}
#else
thr->self = pthread_self();
#endif /* SET_THREAD_SELF */
- SET_THR(thr);
+ PERL_SET_THX(thr);
/*
* These must come after the SET_THR because sv_setpvn does
https://perl5.git.perl.org / perl5.git / blobdiff