#include "EXTERN.h"
#define PERL_IN_PERL_C
#include "perl.h"
+#include "patchlevel.h" /* for local_patches */
/* XXX If this causes problems, set i_unistd=undef in the hint file. */
#ifdef I_UNISTD
#endif
#ifdef PERL_OBJECT
-CPerlObj* perl_alloc(IPerlMem* ipM, IPerlEnv* ipE, IPerlStdIO* ipStd,
- IPerlLIO* ipLIO, IPerlDir* ipD, IPerlSock* ipS, IPerlProc* ipP)
+CPerlObj*
+perl_alloc(struct IPerlMem* ipM, struct IPerlEnv* ipE,
+ struct IPerlStdIO* ipStd, struct IPerlLIO* ipLIO,
+ struct IPerlDir* ipD, struct IPerlSock* ipS,
+ struct IPerlProc* ipP)
{
CPerlObj* pPerl = new(ipM) CPerlObj(ipM, ipE, ipStd, ipLIO, ipD, ipS, ipP);
- if(pPerl != NULL)
+ if (pPerl != NULL)
pPerl->Init();
return pPerl;
}
#else
+
+#ifdef PERL_IMPLICIT_SYS
+PerlInterpreter *
+perl_alloc_using(struct IPerlMem* ipM, struct IPerlEnv* ipE,
+ struct IPerlStdIO* ipStd, struct IPerlLIO* ipLIO,
+ struct IPerlDir* ipD, struct IPerlSock* ipS,
+ struct IPerlProc* ipP)
+{
+ PerlInterpreter *my_perl;
+
+ /* New() needs interpreter, so call malloc() instead */
+ my_perl = (PerlInterpreter*)(*ipM->pMalloc)(ipM, sizeof(PerlInterpreter));
+ PERL_SET_INTERP(my_perl);
+ Zero(my_perl, 1, PerlInterpreter);
+ PL_Mem = ipM;
+ PL_Env = ipE;
+ PL_StdIO = ipStd;
+ PL_LIO = ipLIO;
+ PL_Dir = ipD;
+ PL_Sock = ipS;
+ PL_Proc = ipP;
+ return my_perl;
+}
+#else
PerlInterpreter *
perl_alloc(void)
{
PerlInterpreter *my_perl;
- New(53, my_perl, 1, PerlInterpreter);
+ /* New() needs interpreter, so call malloc() instead */
+ my_perl = (PerlInterpreter*)PerlMem_malloc(sizeof(PerlInterpreter));
PERL_SET_INTERP(my_perl);
return my_perl;
}
+#endif /* PERL_IMPLICIT_SYS */
#endif /* PERL_OBJECT */
void
#ifdef USE_THREADS
int i;
#ifndef FAKE_THREADS
- struct perl_thread *thr;
+ struct perl_thread *thr = NULL;
#endif /* FAKE_THREADS */
#endif /* USE_THREADS */
#ifdef MULTIPLICITY
- Zero(my_perl, 1, PerlInterpreter);
+ init_interp();
+ PL_perl_destruct_level = 1;
+#else
+ if (PL_perl_destruct_level > 0)
+ init_interp();
#endif
/* Init the real globals (and main thread)? */
PL_rs = SvREFCNT_inc(PL_nrs);
init_stacks();
-#ifdef MULTIPLICITY
- init_interp();
- PL_perl_destruct_level = 1;
-#else
- if (PL_perl_destruct_level > 0)
- init_interp();
-#endif
init_ids();
PL_lex_state = LEX_NOTPARSING;
init_i18nl10n(1);
SET_NUMERIC_STANDARD();
+
#if defined(PERL_SUBVERSION) && PERL_SUBVERSION > 0
sprintf(PL_patchlevel, "%7.5f", (double) PERL_REVISION
+ ((double) PERL_VERSION / (double) 1000)
PL_fdpid = newAV(); /* for remembering popen pids by fd */
PL_modglobal = newHV(); /* pointers to per-interpreter module globals */
- DEBUG( {
- New(51,PL_debname,128,char);
- New(52,PL_debdelim,128,char);
- } )
-
ENTER;
}
/* Pass 1 on any remaining threads: detach joinables, join zombies */
retry_cleanup:
MUTEX_LOCK(&PL_threads_mutex);
- DEBUG_S(PerlIO_printf(PerlIO_stderr(),
+ DEBUG_S(PerlIO_printf(Perl_debug_log,
"perl_destruct: waiting for %d threads...\n",
PL_nthreads - 1));
for (t = thr->next; t != thr; t = t->next) {
switch (ThrSTATE(t)) {
AV *av;
case THRf_ZOMBIE:
- DEBUG_S(PerlIO_printf(PerlIO_stderr(),
+ DEBUG_S(PerlIO_printf(Perl_debug_log,
"perl_destruct: joining zombie %p\n", t));
ThrSETSTATE(t, THRf_DEAD);
MUTEX_UNLOCK(&t->mutex);
MUTEX_UNLOCK(&PL_threads_mutex);
JOIN(t, &av);
SvREFCNT_dec((SV*)av);
- DEBUG_S(PerlIO_printf(PerlIO_stderr(),
+ DEBUG_S(PerlIO_printf(Perl_debug_log,
"perl_destruct: joined zombie %p OK\n", t));
goto retry_cleanup;
case THRf_R_JOINABLE:
- DEBUG_S(PerlIO_printf(PerlIO_stderr(),
+ DEBUG_S(PerlIO_printf(Perl_debug_log,
"perl_destruct: detaching thread %p\n", t));
ThrSETSTATE(t, THRf_R_DETACHED);
/*
MUTEX_UNLOCK(&t->mutex);
goto retry_cleanup;
default:
- DEBUG_S(PerlIO_printf(PerlIO_stderr(),
+ DEBUG_S(PerlIO_printf(Perl_debug_log,
"perl_destruct: ignoring %p (state %u)\n",
t, ThrSTATE(t)));
MUTEX_UNLOCK(&t->mutex);
/* Pass 2 on remaining threads: wait for the thread count to drop to one */
while (PL_nthreads > 1)
{
- DEBUG_S(PerlIO_printf(PerlIO_stderr(),
+ DEBUG_S(PerlIO_printf(Perl_debug_log,
"perl_destruct: final wait for %d threads\n",
PL_nthreads - 1));
COND_WAIT(&PL_nthreads_cond, &PL_threads_mutex);
}
/* At this point, we're the last thread */
MUTEX_UNLOCK(&PL_threads_mutex);
- DEBUG_S(PerlIO_printf(PerlIO_stderr(), "perl_destruct: armageddon has arrived\n"));
+ DEBUG_S(PerlIO_printf(Perl_debug_log, "perl_destruct: armageddon has arrived\n"));
MUTEX_DESTROY(&PL_threads_mutex);
COND_DESTROY(&PL_nthreads_cond);
#endif /* !defined(FAKE_THREADS) */
PL_warnhook = Nullsv;
SvREFCNT_dec(PL_diehook);
PL_diehook = Nullsv;
- SvREFCNT_dec(PL_parsehook);
- PL_parsehook = Nullsv;
/* call exit list functions */
while (PL_exitlistlen-- > 0)
PL_dowarn = G_WARN_OFF;
PL_doextract = FALSE;
PL_sawampersand = FALSE; /* must save all match strings */
- PL_sawstudy = FALSE; /* do fbm_instr on all strings */
- PL_sawvec = FALSE;
PL_unsafe = FALSE;
Safefree(PL_inplace);
Safefree(PL_screamnext);
PL_screamnext = 0;
+ /* float buffer */
+ Safefree(PL_efloatbuf);
+ PL_efloatbuf = Nullch;
+ PL_efloatsize = 0;
+
/* startup and shutdown function lists */
SvREFCNT_dec(PL_beginav);
SvREFCNT_dec(PL_endav);
/* shortcuts just get cleared */
PL_envgv = Nullgv;
- PL_siggv = Nullgv;
PL_incgv = Nullgv;
PL_hintgv = Nullgv;
PL_errgv = Nullgv;
PL_argvgv = Nullgv;
PL_argvoutgv = Nullgv;
PL_stdingv = Nullgv;
+ PL_stderrgv = Nullgv;
PL_last_in_gv = Nullgv;
PL_replgv = Nullgv;
PL_defstash = 0;
SvREFCNT_dec(hv);
+ /* clear queued errors */
+ SvREFCNT_dec(PL_errors);
+ PL_errors = Nullsv;
+
FREETMPS;
if (destruct_level >= 2 && ckWARN_d(WARN_INTERNAL)) {
if (PL_scopestack_ix != 0)
perl_free(pTHXx)
{
#if defined(PERL_OBJECT)
- Safefree(this);
+ PerlMem_free(this);
#else
- Safefree(aTHXx);
+ PerlMem_free(aTHXx);
#endif
}
dTHR;
I32 oldscope;
int ret;
+ dJMPENV;
#ifdef USE_THREADS
dTHX;
#endif
oldscope = PL_scopestack_ix;
PL_dowarn = G_WARN_OFF;
- CALLPROTECT(aTHX_ &ret, MEMBER_TO_FPTR(S_parse_body), env, xsinit);
+ CALLPROTECT(aTHX_ pcur_env, &ret, MEMBER_TO_FPTR(S_parse_body),
+ env, xsinit);
switch (ret) {
case 0:
return 0;
LEAVE;
FREETMPS;
PL_curstash = PL_defstash;
- if (PL_endav)
+ if (PL_endav && !PL_minus_c)
call_list(oldscope, PL_endav);
return STATUS_NATIVE_EXPORT;
case 3:
- PerlIO_printf(PerlIO_stderr(), "panic: top_env\n");
+ PerlIO_printf(Perl_error_log, "panic: top_env\n");
return 1;
}
return 0;
AV* comppadlist;
register SV *sv;
register char *s;
+ char *cddir = Nullch;
XSINIT_t xsinit = va_arg(args, XSINIT_t);
#else
sv_catpv(PL_Sv,"print \"\\nCharacteristics of this binary (from libperl): \\n\",");
#endif
-#if defined(DEBUGGING) || defined(MULTIPLICITY)
sv_catpv(PL_Sv,"\" Compile-time options:");
# ifdef DEBUGGING
sv_catpv(PL_Sv," DEBUGGING");
# ifdef MULTIPLICITY
sv_catpv(PL_Sv," MULTIPLICITY");
# endif
+# ifdef USE_THREADS
+ sv_catpv(PL_Sv," USE_THREADS");
+# endif
+# ifdef PERL_OBJECT
+ sv_catpv(PL_Sv," PERL_OBJECT");
+# endif
+# ifdef PERL_IMPLICIT_CONTEXT
+ sv_catpv(PL_Sv," PERL_IMPLICIT_CONTEXT");
+# endif
+# ifdef PERL_IMPLICIT_SYS
+ sv_catpv(PL_Sv," PERL_IMPLICIT_SYS");
+# endif
sv_catpv(PL_Sv,"\\n\",");
-#endif
+
#if defined(LOCAL_PATCH_COUNT)
if (LOCAL_PATCH_COUNT > 0) {
int i;
PL_doextract = TRUE;
s++;
if (*s)
- PL_cddir = savepv(s);
+ cddir = s;
break;
case 0:
break;
validate_suid(validarg, scriptname,fdscript);
- if (PL_doextract)
+#if defined(SIGCHLD) || defined(SIGCLD)
+ {
+#ifndef SIGCHLD
+# define SIGCHLD SIGCLD
+#endif
+ Sighandler_t sigstate = rsignal_state(SIGCHLD);
+ if (sigstate == SIG_IGN) {
+ if (ckWARN(WARN_SIGNAL))
+ Perl_warner(aTHX_ WARN_SIGNAL,
+ "Can't ignore signal CHLD, forcing to default");
+ (void)rsignal(SIGCHLD, (Sighandler_t)SIG_DFL);
+ }
+ }
+#endif
+
+ if (PL_doextract) {
find_beginning();
+ if (cddir && PerlDir_chdir(cddir) < 0)
+ Perl_croak(aTHX_ "Can't chdir to %s",cddir);
+
+ }
PL_main_cv = PL_compcv = (CV*)NEWSV(1104,0);
sv_upgrade((SV *)PL_compcv, SVt_PVCV);
CvPADLIST(PL_compcv) = comppadlist;
boot_core_UNIVERSAL();
+ boot_core_xsutils();
if (xsinit)
(*xsinit)(aTHXo); /* in case linked C routines want magical variables */
dTHR;
I32 oldscope;
int ret;
+ dJMPENV;
#ifdef USE_THREADS
dTHX;
#endif
oldscope = PL_scopestack_ix;
redo_body:
- CALLPROTECT(aTHX_ &ret, MEMBER_TO_FPTR(S_run_body), oldscope);
+ CALLPROTECT(aTHX_ pcur_env, &ret, MEMBER_TO_FPTR(S_run_body), oldscope);
switch (ret) {
case 1:
cxstack_ix = -1; /* start context stack again */
LEAVE;
FREETMPS;
PL_curstash = PL_defstash;
- if (PL_endav)
+ if (PL_endav && !PL_minus_c)
call_list(oldscope, PL_endav);
#ifdef MYMALLOC
if (PerlEnv_getenv("PERL_DEBUG_MSTATS"))
POPSTACK_TO(PL_mainstack);
goto redo_body;
}
- PerlIO_printf(PerlIO_stderr(), "panic: restartop\n");
+ PerlIO_printf(Perl_error_log, "panic: restartop\n");
FREETMPS;
return 1;
}
if (!PL_restartop) {
DEBUG_x(dump_all());
DEBUG(PerlIO_printf(Perl_debug_log, "\nEXECUTING...\n\n"));
- DEBUG_S(PerlIO_printf(Perl_debug_log, "main thread is 0x%lx\n",
- (unsigned long) thr));
+ DEBUG_S(PerlIO_printf(Perl_debug_log, "main thread is 0x%"UVxf"\n",
+ PTR2UV(thr)));
if (PL_minus_c) {
- PerlIO_printf(PerlIO_stderr(), "%s syntax OK\n", PL_origfilename);
+ PerlIO_printf(Perl_error_log, "%s syntax OK\n", PL_origfilename);
my_exit(0);
}
if (PERLDB_SINGLE && PL_DBsingle)
bool oldcatch = CATCH_GET;
int ret;
OP* oldop = PL_op;
+ dJMPENV;
if (flags & G_DISCARD) {
ENTER;
CATCH_SET(TRUE);
call_xbody((OP*)&myop, FALSE);
retval = PL_stack_sp - (PL_stack_base + oldmark);
- CATCH_SET(FALSE);
+ CATCH_SET(oldcatch);
}
else {
cLOGOP->op_other = PL_op;
PL_markstack_ptr++;
redo_body:
- CALLPROTECT(aTHX_ &ret, MEMBER_TO_FPTR(S_call_body), (OP*)&myop, FALSE);
+ CALLPROTECT(aTHX_ pcur_env, &ret, MEMBER_TO_FPTR(S_call_body),
+ (OP*)&myop, FALSE);
switch (ret) {
case 0:
retval = PL_stack_sp - (PL_stack_base + oldmark);
I32 oldscope;
int ret;
OP* oldop = PL_op;
+ dJMPENV;
if (flags & G_DISCARD) {
ENTER;
myop.op_flags |= OPf_SPECIAL;
redo_body:
- CALLPROTECT(aTHX_ &ret, MEMBER_TO_FPTR(S_call_body), (OP*)&myop, TRUE);
+ CALLPROTECT(aTHX_ pcur_env, &ret, MEMBER_TO_FPTR(S_call_body),
+ (OP*)&myop, TRUE);
switch (ret) {
case 0:
retval = PL_stack_sp - (PL_stack_base + oldmark);
case '0':
{
dTHR;
- rschar = scan_oct(s, 4, &numlen);
+ rschar = (U32)scan_oct(s, 4, &numlen);
SvREFCNT_dec(PL_nrs);
if (rschar & ~((U8)~0))
PL_nrs = &PL_sv_undef;
if (isDIGIT(*s)) {
PL_ors = savepv("\n");
PL_orslen = 1;
- *PL_ors = scan_oct(s, 3 + (*s == '0'), &numlen);
+ *PL_ors = (char)scan_oct(s, 3 + (*s == '0'), &numlen);
s += numlen;
}
else {
#if defined(LOCAL_PATCH_COUNT)
if (LOCAL_PATCH_COUNT > 0)
printf("\n(with %d registered patch%s, see perl -V for more detail)",
- LOCAL_PATCH_COUNT, (LOCAL_PATCH_COUNT!=1) ? "es" : "");
+ (int)LOCAL_PATCH_COUNT, (LOCAL_PATCH_COUNT!=1) ? "es" : "");
#endif
printf("\n\nCopyright 1987-1999, Larry Wall\n");
PL_curcop = &PL_compiling;\
PL_curcopdb = NULL; \
PL_dbargs = 0; \
- PL_dlmax = 128; \
PL_dumpindent = 4; \
PL_laststatval = -1; \
PL_laststype = OP_STAT; \
PL_tmps_floor = -1; \
PL_tmps_ix = -1; \
PL_op_mask = NULL; \
- PL_dlmax = 128; \
PL_laststatval = -1; \
PL_laststype = OP_STAT; \
PL_mess_sv = Nullsv; \
# define PERLVAR(var,type)
# define PERLVARA(var,n,type)
# if defined(PERL_IMPLICIT_CONTEXT)
-# define PERLVARI(var,type,init) my_perl->var = init;
-# define PERLVARIC(var,type,init) my_perl->var = init;
+# if defined(USE_THREADS)
+# define PERLVARI(var,type,init) PERL_GET_INTERP->var = init;
+# define PERLVARIC(var,type,init) PERL_GET_INTERP->var = init;
+# else /* !USE_THREADS */
+# define PERLVARI(var,type,init) aTHX->var = init;
+# define PERLVARIC(var,type,init) aTHX->var = init;
+# endif /* USE_THREADS */
# else
# define PERLVARI(var,type,init) PERL_GET_INTERP->var = init;
# define PERLVARIC(var,type,init) PERL_GET_INTERP->var = init;
STATIC int
S_fd_on_nosuid_fs(pTHX_ int fd)
{
- int on_nosuid = 0;
- int check_okay = 0;
+ int check_okay = 0; /* able to do all the required sys/libcalls */
+ int on_nosuid = 0; /* the fd is on a nosuid fs */
/*
- * Preferred order: fstatvfs(), fstatfs(), getmntent().
+ * Preferred order: fstatvfs(), fstatfs(), ustat()+getmnt(), getmntent().
* fstatvfs() is UNIX98.
- * fstatfs() is BSD.
- * getmntent() is O(number-of-mounted-filesystems) and can hang.
+ * fstatfs() is 4.3 BSD.
+ * ustat()+getmnt() is pre-4.3 BSD.
+ * getmntent() is O(number-of-mounted-filesystems) and can hang on
+ * an irrelevant filesystem while trying to reach the right one.
*/
# ifdef HAS_FSTATVFS
check_okay = fstatvfs(fd, &stfs) == 0;
on_nosuid = check_okay && (stfs.f_flag & ST_NOSUID);
# else
-# if defined(HAS_FSTATFS) && defined(HAS_STRUCT_STATFS_FLAGS)
+# ifdef PERL_MOUNT_NOSUID
+# if defined(HAS_FSTATFS) && \
+ defined(HAS_STRUCT_STATFS) && \
+ defined(HAS_STRUCT_STATFS_F_FLAGS)
struct statfs stfs;
check_okay = fstatfs(fd, &stfs) == 0;
-# undef PERL_MOUNT_NOSUID
-# if !defined(PERL_MOUNT_NOSUID) && defined(MNT_NOSUID)
-# define PERL_MOUNT_NOSUID MNT_NOSUID
-# endif
-# if !defined(PERL_MOUNT_NOSUID) && defined(MS_NOSUID)
-# define PERL_MOUNT_NOSUID MS_NOSUID
-# endif
-# if !defined(PERL_MOUNT_NOSUID) && defined(M_NOSUID)
-# define PERL_MOUNT_NOSUID M_NOSUID
-# endif
-# ifdef PERL_MOUNT_NOSUID
on_nosuid = check_okay && (stfs.f_flags & PERL_MOUNT_NOSUID);
-# endif
+# else
+# if defined(HAS_FSTAT) && \
+ defined(HAS_USTAT) && \
+ defined(HAS_GETMNT) && \
+ defined(HAS_STRUCT_FS_DATA) &&
+ defined(NOSTAT_ONE)
+ struct stat fdst;
+ if (fstat(fd, &fdst) == 0) {
+ struct ustat us;
+ if (ustat(fdst.st_dev, &us) == 0) {
+ struct fs_data fsd;
+ /* NOSTAT_ONE here because we're not examining fields which
+ * vary between that case and STAT_ONE. */
+ if (getmnt((int*)0, &fsd, (int)0, NOSTAT_ONE, us.f_fname) == 0) {
+ size_t cmplen = sizeof(us.f_fname);
+ if (sizeof(fsd.fd_req.path) < cmplen)
+ cmplen = sizeof(fsd.fd_req.path);
+ if (strnEQ(fsd.fd_req.path, us.f_fname, cmplen) &&
+ fdst.st_dev == fsd.fd_req.dev) {
+ check_okay = 1;
+ on_nosuid = fsd.fd_req.flags & PERL_MOUNT_NOSUID;
+ }
+ }
+ }
+ }
+ }
+# endif /* fstat+ustat+getmnt */
+# endif /* fstatfs */
# else
-# if defined(HAS_GETMNTENT) && defined(HAS_HASMNTOPT) && defined(MNTOPT_NOSUID)
+# if defined(HAS_GETMNTENT) && \
+ defined(HAS_HASMNTOPT) && \
+ defined(MNTOPT_NOSUID)
FILE *mtab = fopen("/etc/mtab", "r");
struct mntent *entry;
struct stat stb, fsb;
}
if (mtab)
fclose(mtab);
-# endif /* mntent */
-# endif /* statfs */
+# endif /* getmntent+hasmntopt */
+# endif /* PERL_MOUNT_NOSUID: fstatfs or fstat+ustat+statfs */
# endif /* statvfs */
+
if (!check_okay)
- Perl_croak(aTHX_ "Can't check filesystem of script \"%s\"", PL_origfilename);
+ Perl_croak(aTHX_ "Can't check filesystem of script \"%s\" for nosuid", PL_origfilename);
return on_nosuid;
}
#endif /* IAMSUID */
/*SUPPRESS 530*/
while (s = moreswitches(s)) ;
}
- if (PL_cddir && PerlDir_chdir(PL_cddir) < 0)
- Perl_croak(aTHX_ "Can't chdir to %s",PL_cddir);
}
}
}
STATIC void
S_init_ids(pTHX)
{
- PL_uid = (int)PerlProc_getuid();
- PL_euid = (int)PerlProc_geteuid();
- PL_gid = (int)PerlProc_getgid();
- PL_egid = (int)PerlProc_getegid();
+ PL_uid = PerlProc_getuid();
+ PL_euid = PerlProc_geteuid();
+ PL_gid = PerlProc_getgid();
+ PL_egid = PerlProc_getegid();
#ifdef VMS
PL_uid |= PL_gid << 16;
PL_euid |= PL_egid << 16;
Safefree(PL_scopestack);
Safefree(PL_savestack);
Safefree(PL_retstack);
- DEBUG( {
- Safefree(PL_debname);
- Safefree(PL_debdelim);
- } )
}
#ifndef PERL_OBJECT
GvMULTI_on(tmpgv);
GvIOp(tmpgv) = (IO*)SvREFCNT_inc(io);
- othergv = gv_fetchpv("STDERR",TRUE, SVt_PVIO);
- GvMULTI_on(othergv);
- io = GvIOp(othergv);
+ PL_stderrgv = gv_fetchpv("STDERR",TRUE, SVt_PVIO);
+ GvMULTI_on(PL_stderrgv);
+ io = GvIOp(PL_stderrgv);
IoOFP(io) = IoIFP(io) = PerlIO_stderr();
tmpgv = gv_fetchpv("stderr",TRUE, SVt_PV);
GvMULTI_on(tmpgv);
magicname("0", "0", 1);
}
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)) {
GvMULTI_on(PL_argvgv);
(void)gv_AVadd(PL_argvgv);
sv_usepvn(libdir,unix,len);
}
else
- PerlIO_printf(PerlIO_stderr(),
+ PerlIO_printf(Perl_error_log,
"Failed to unixify @INC element \"%s\"\n",
SvPV(libdir,len));
#endif
thr->threadsv = newAV();
/* thr->threadsvp is set when find_threadsv is called */
thr->specific = newAV();
- thr->errhv = newHV();
thr->flags = THRf_R_JOINABLE;
MUTEX_INIT(&thr->mutex);
/* Handcraft thrsv similarly to mess_sv */
CV *cv;
STRLEN len;
int ret;
+ dJMPENV;
while (AvFILL(paramList) >= 0) {
cv = (CV*)av_shift(paramList);
SAVEFREESV(cv);
- CALLPROTECT(aTHX_ &ret, MEMBER_TO_FPTR(S_call_list_body), cv);
+ CALLPROTECT(aTHX_ pcur_env, &ret, MEMBER_TO_FPTR(S_call_list_body), cv);
switch (ret) {
case 0:
(void)SvPV(atsv, len);
LEAVE;
FREETMPS;
PL_curstash = PL_defstash;
- if (PL_endav)
+ if (PL_endav && !PL_minus_c)
call_list(oldscope, PL_endav);
PL_curcop = &PL_compiling;
PL_curcop->cop_line = oldline;
PL_curcop->cop_line = oldline;
JMPENV_JUMP(3);
}
- PerlIO_printf(PerlIO_stderr(), "panic: restartop\n");
+ PerlIO_printf(Perl_error_log, "panic: restartop\n");
FREETMPS;
break;
}
return 1;
}
-
projects / p5sagit/p5-mst-13.2.git / blobdiff