PL_Dir = ipD;
PL_Sock = ipS;
PL_Proc = ipP;
+ INIT_TRACK_MEMPOOL(PL_memory_debug_header, my_perl);
return my_perl;
}
my_perl = (PerlInterpreter*)PerlMem_malloc(sizeof(PerlInterpreter));
S_init_tls_and_interp(my_perl);
+#ifndef PERL_TRACK_MEMPOOL
return (PerlInterpreter *) ZeroD(my_perl, 1, PerlInterpreter);
+#else
+ Zero(my_perl, 1, PerlInterpreter);
+ INIT_TRACK_MEMPOOL(PL_memory_debug_header, my_perl);
+ return my_perl;
+#endif
}
#endif /* PERL_IMPLICIT_SYS */
void
perl_free(pTHXx)
{
+#ifdef PERL_TRACK_MEMPOOL
+ /* Emulate the PerlHost behaviour of free()ing all memory allocated in this
+ thread at thread exit. */
+ while(aTHXx->Imemory_debug_header.next != &(aTHXx->Imemory_debug_header))
+ safesysfree(sTHX + (char *)(aTHXx->Imemory_debug_header.next));
+#endif
+
#if defined(WIN32) || defined(NETWARE)
# if defined(PERL_IMPLICIT_SYS)
+ {
# ifdef NETWARE
- void *host = nw_internal_host;
+ void *host = nw_internal_host;
# else
- void *host = w32_internal_host;
+ void *host = w32_internal_host;
# endif
- PerlMem_free(aTHXx);
+ PerlMem_free(aTHXx);
# ifdef NETWARE
- nw_delete_internal_host(host);
+ nw_delete_internal_host(host);
# else
- win32_delete_internal_host(host);
+ win32_delete_internal_host(host);
# endif
+ }
# else
PerlMem_free(aTHXx);
# endif
case 'X':
case 'w':
case 'A':
- if ((s = moreswitches(s, -1)))
+ if ((s = moreswitches(s)))
goto reswitch;
break;
PL_tainting = TRUE;
}
} else {
- moreswitches(d, -1);
+ moreswitches(d);
}
}
}
else if (scriptname == NULL) {
#ifdef MSDOS
if ( PerlLIO_isatty(PerlIO_fileno(PerlIO_stdin())) )
- moreswitches("h", -1);
+ moreswitches("h");
#endif
scriptname = "-";
}
|| gMacPerl_AlwaysExtract
#endif
) {
- find_beginning(suidscript);
+
+ /* This will croak if suidscript is >= 0, as -x cannot be used with
+ setuid scripts. */
+ forbid_setid('x', suidscript);
+ /* Hence you can't get here if suidscript >= 0 */
+
+ find_beginning();
if (cddir && PerlDir_chdir( (char *)cddir ) < 0)
Perl_croak(aTHX_ "Can't chdir to %s",cddir);
}
/* This routine handles any switches that can be given during run */
char *
-Perl_moreswitches(pTHX_ char *s, const int suidscript)
+Perl_moreswitches(pTHX_ char *s)
{
dVAR;
UV rschar;
s++;
return s;
case 'd':
- forbid_setid('d', suidscript);
+ forbid_setid('d', -1);
s++;
/* -dt indicates to the debugger that threads will be used */
case 'D':
{
#ifdef DEBUGGING
- forbid_setid('D', suidscript);
+ forbid_setid('D', -1);
s++;
PL_debug = get_debug_opts( (const char **)&s, 1) | DEBUG_TOP_FLAG;
#else /* !DEBUGGING */
}
return s;
case 'I': /* -I handled both here and in parse_body() */
- forbid_setid('I', suidscript);
+ forbid_setid('I', -1);
++s;
while (*s && isSPACE(*s))
++s;
}
return s;
case 'A':
- forbid_setid('A', suidscript);
+ forbid_setid('A', -1);
if (!PL_preambleav)
PL_preambleav = newAV();
s++;
return s;
}
case 'M':
- forbid_setid('M', suidscript); /* XXX ? */
+ forbid_setid('M', -1); /* XXX ? */
/* FALL THROUGH */
case 'm':
- forbid_setid('m', suidscript); /* XXX ? */
+ forbid_setid('m', -1); /* XXX ? */
if (*++s) {
char *start;
SV *sv;
s++;
return s;
case 's':
- forbid_setid('s', suidscript);
+ forbid_setid('s', -1);
PL_doswitches = TRUE;
s++;
return s;
sv_setpvn(get_sv("/", TRUE), "\n", 1);
}
-/* PSz 18 Nov 03 fdscript now global but do not change prototype */
STATIC int
S_open_script(pTHX_ const char *scriptname, bool dosearch, SV *sv,
int *suidscript)
}
STATIC void
-S_find_beginning(pTHX_ const int suidscript)
+S_find_beginning(pTHX)
{
dVAR;
register char *s;
/* skip forward in input to the real script? */
- forbid_setid('x', suidscript);
#ifdef MACOS_TRADITIONAL
/* Since the Mac OS does not honor #! arguments for us, we do it ourselves */
while (isDIGIT(s2[-1]) || s2[-1] == '-' || s2[-1] == '.'
|| s2[-1] == '_') s2--;
if (strnEQ(s2-4,"perl",4))
- while ((s = moreswitches(s, -1)))
+ while ((s = moreswitches(s)))
;
}
#ifdef MACOS_TRADITIONAL