static void init_debugger _((void));
static void init_lexer _((void));
static void init_main_stash _((void));
+#ifdef USE_THREADS
+static struct perl_thread * init_main_thread _((void));
+#endif /* USE_THREADS */
static void init_perllib _((void));
static void init_postdump_symbols _((int, char **, char **));
static void init_predump_symbols _((void));
static void
catch_sigsegv(int signo, struct sigcontext_struct sc)
{
- signal(SIGSEGV, SIG_DFL);
+ PerlProc_signal(SIGSEGV, SIG_DFL);
fprintf(stderr, "Segmentation fault dereferencing 0x%lx\n"
"return_address = 0x%lx, eip = 0x%lx\n",
sc.cr2, __builtin_return_address(0), sc.eip);
void
perl_construct(register PerlInterpreter *sv_interp)
{
-#if defined(USE_THREADS) && !defined(FAKE_THREADS)
- struct thread *thr;
-#endif
+#ifdef USE_THREADS
+ int i;
+#ifndef FAKE_THREADS
+ struct perl_thread *thr;
+#endif /* FAKE_THREADS */
+#endif /* USE_THREADS */
if (!(curinterp = sv_interp))
return;
/* Init the real globals (and main thread)? */
if (!linestr) {
#ifdef USE_THREADS
- XPV *xpv;
INIT_THREADS;
- Newz(53, thr, 1, struct thread);
- MUTEX_INIT(&malloc_mutex);
+#ifdef ALLOC_THREAD_KEY
+ ALLOC_THREAD_KEY;
+#else
+ if (pthread_key_create(&thr_key, 0))
+ croak("panic: pthread_key_create");
+#endif
MUTEX_INIT(&sv_mutex);
- /* Safe to use SVs from now on */
+ /*
+ * Safe to use basic SV functions from now on (though
+ * not things like mortals or tainting yet).
+ */
MUTEX_INIT(&eval_mutex);
COND_INIT(&eval_cond);
MUTEX_INIT(&threads_mutex);
COND_INIT(&nthreads_cond);
- nthreads = 1;
- cvcache = newHV();
- curcop = &compiling;
- thr->flags = THRf_R_JOINABLE;
- MUTEX_INIT(&thr->mutex);
- thr->next = thr;
- thr->prev = thr;
- thr->tid = 0;
-
- /* Handcraft thrsv similarly to mess_sv */
- New(53, thrsv, 1, SV);
- Newz(53, xpv, 1, XPV);
- SvFLAGS(thrsv) = SVt_PV;
- SvANY(thrsv) = (void*)xpv;
- SvREFCNT(thrsv) = 1 << 30; /* practically infinite */
- SvPVX(thrsv) = (char*)thr;
- SvCUR_set(thrsv, sizeof(thr));
- SvLEN_set(thrsv, sizeof(thr));
- *SvEND(thrsv) = '\0'; /* in the trailing_nul field */
- oursv = thrsv;
-#ifdef HAVE_THREAD_INTERN
- init_thread_intern(thr);
-#else
- thr->self = pthread_self();
- if (pthread_key_create(&thr_key, 0))
- croak("panic: pthread_key_create");
-#endif /* HAVE_THREAD_INTERN */
- SET_THR(thr);
+
+ thr = init_main_thread();
#endif /* USE_THREADS */
linestr = NEWSV(65,80);
#ifdef DEBUGGING
{
char *s;
- if (s = getenv("PERL_DESTRUCT_LEVEL")) {
+ if (s = PerlEnv_getenv("PERL_DESTRUCT_LEVEL")) {
int i = atoi(s);
if (destruct_level < i)
destruct_level = i;
/* defgv, aka *_ should be taken care of elsewhere */
-#if 0 /* just about all regexp stuff, seems to be ok */
-
- /* shortcuts to regexp stuff */
- leftgv = Nullgv;
- ampergv = Nullgv;
-
- SAVEFREEOP(curpm);
- SAVEFREEOP(oldlastpm); /* for saving regexp context during debugger */
-
- regprecomp = NULL; /* uncompiled string. */
- regparse = NULL; /* Input-scan pointer. */
- regxend = NULL; /* End of input for compile */
- regnpar = 0; /* () count. */
- regcode = NULL; /* Code-emit pointer; ®dummy = don't. */
- regsize = 0; /* Code size. */
- regnaughty = 0; /* How bad is this pattern? */
- regsawback = 0; /* Did we see \1, ...? */
-
- reginput = NULL; /* String-input pointer. */
- regbol = NULL; /* Beginning of input, for ^ check. */
- regeol = NULL; /* End of input, for $ check. */
- regstartp = (char **)NULL; /* Pointer to startp array. */
- regendp = (char **)NULL; /* Ditto for endp. */
- reglastparen = 0; /* Similarly for lastparen. */
- regtill = NULL; /* How far we are required to go. */
- regflags = 0; /* are we folding, multilining? */
- regprev = (char)NULL; /* char before regbol, \n if none */
-
-#endif /* if 0 */
-
/* clean up after study() */
SvREFCNT_dec(lastscream);
lastscream = Nullsv;
DEBUG_P(debprofdump());
#ifdef USE_THREADS
MUTEX_DESTROY(&sv_mutex);
- MUTEX_DESTROY(&malloc_mutex);
MUTEX_DESTROY(&eval_mutex);
COND_DESTROY(&eval_cond);
croak("No -e allowed in setuid scripts");
if (!e_fp) {
e_tmpname = savepv(TMPPATH);
- (void)mktemp(e_tmpname);
+ (void)PerlLIO_mktemp(e_tmpname);
if (!*e_tmpname)
croak("Can't mktemp()");
e_fp = PerlIO_open(e_tmpname,"w");
}
switch_end:
- if (!tainting && (s = getenv("PERL5OPT"))) {
+ if (!tainting && (s = PerlEnv_getenv("PERL5OPT"))) {
while (s && *s) {
while (isSPACE(*s))
s++;
}
else if (scriptname == Nullch) {
#ifdef MSDOS
- if ( isatty(PerlIO_fileno(PerlIO_stdin())) )
+ if ( PerlLIO_isatty(PerlIO_fileno(PerlIO_stdin())) )
moreswitches("h");
#endif
scriptname = "-";
boot_core_UNIVERSAL();
if (xsinit)
(*xsinit)(); /* in case linked C routines want magical variables */
-#if defined(VMS) || defined(WIN32)
+#if defined(VMS) || defined(WIN32) || defined(DJGPP)
init_os_extras();
#endif
#if defined(DEBUGGING) && defined(USE_THREADS) && defined(__linux__)
- DEBUG_L(signal(SIGSEGV, (void(*)(int))catch_sigsegv););
+ DEBUG_L(PerlProc_signal(SIGSEGV, (void(*)(int))catch_sigsegv););
#endif
init_predump_symbols();
/* now parse the script */
+ SETERRNO(0,SS$_NORMAL);
error_count = 0;
if (yyparse() || error_count) {
if (minus_c)
/* now that script is parsed, we can modify record separator */
SvREFCNT_dec(rs);
rs = SvREFCNT_inc(nrs);
+#ifdef USE_THREADS
+ sv_setsv(*av_fetch(thr->threadsv, find_threadsv("/"), FALSE), rs);
+#else
sv_setsv(GvSV(gv_fetchpv("/", TRUE, SVt_PV)), rs);
-
+#endif /* USE_THREADS */
if (do_undump)
my_unexec();
FREETMPS;
#ifdef MYMALLOC
- if ((s=getenv("PERL_DEBUG_MSTATS")) && atoi(s) >= 2)
+ if ((s=PerlEnv_getenv("PERL_DEBUG_MSTATS")) && atoi(s) >= 2)
dump_mstats("after compilation:");
#endif
if (endav)
call_list(oldscope, endav);
#ifdef MYMALLOC
- if (getenv("PERL_DEBUG_MSTATS"))
+ if (PerlEnv_getenv("PERL_DEBUG_MSTATS"))
dump_mstats("after execution: ");
#endif
JMPENV_POP;
SV*
perl_get_sv(char *name, I32 create)
{
- GV* gv = gv_fetchpv(name, create, SVt_PV);
+ GV *gv;
+#ifdef USE_THREADS
+ if (name[1] == '\0' && !isALPHA(name[0])) {
+ PADOFFSET tmp = find_threadsv(name);
+ if (tmp != NOT_IN_PAD) {
+ dTHR;
+ return *av_fetch(thr->threadsv, tmp, FALSE);
+ }
+ }
+#endif /* USE_THREADS */
+ gv = gv_fetchpv(name, create, SVt_PV);
if (gv)
return GvSV(gv);
return Nullsv;
/* Be sure to refetch the stack pointer after calling these routines. */
I32
-perl_call_argv(char *subname, I32 flags, register char **argv)
+perl_call_argv(char *sub_name, I32 flags, register char **argv)
/* See G_* flags in cop.h */
/* null terminated arg list */
{
- dTHR;
dSP;
PUSHMARK(sp);
}
PUTBACK;
}
- return perl_call_pv(subname, flags);
+ return perl_call_pv(sub_name, flags);
}
I32
-perl_call_pv(char *subname, I32 flags)
+perl_call_pv(char *sub_name, I32 flags)
/* name of the subroutine */
/* See G_* flags in cop.h */
{
- return perl_call_sv((SV*)perl_get_cv(subname, TRUE), flags);
+ return perl_call_sv((SV*)perl_get_cv(sub_name, TRUE), flags);
}
I32
/* name of the subroutine */
/* See G_* flags in cop.h */
{
- dTHR;
dSP;
OP myop;
if (!op)
markstack_ptr--;
/* we're trying to emulate pp_entertry() here */
{
- register CONTEXT *cx;
+ register PERL_CONTEXT *cx;
I32 gimme = GIMME_V;
ENTER;
if (flags & G_KEEPERR)
in_eval |= 4;
else
- sv_setpv(GvSV(errgv),"");
+ sv_setpv(ERRSV,"");
}
markstack_ptr++;
runops();
retval = stack_sp - (stack_base + oldmark);
if ((flags & G_EVAL) && !(flags & G_KEEPERR))
- sv_setpv(GvSV(errgv),"");
+ sv_setpv(ERRSV,"");
cleanup:
if (flags & G_EVAL) {
SV **newsp;
PMOP *newpm;
I32 gimme;
- register CONTEXT *cx;
+ register PERL_CONTEXT *cx;
I32 optype;
POPBLOCK(cx,newpm);
runops();
retval = stack_sp - (stack_base + oldmark);
if (!(flags & G_KEEPERR))
- sv_setpv(GvSV(errgv),"");
+ sv_setpv(ERRSV,"");
cleanup:
JMPENV_POP;
SV*
perl_eval_pv(char *p, I32 croak_on_error)
{
- dTHR;
dSP;
SV* sv = newSVpv(p, 0);
sv = POPs;
PUTBACK;
- if (croak_on_error && SvTRUE(GvSV(errgv)))
- croak(SvPVx(GvSV(errgv), na));
+ if (croak_on_error && SvTRUE(ERRSV))
+ croak(SvPVx(ERRSV, na));
return sv;
}
switch (*s) {
case '0':
+ {
+ dTHR;
rschar = scan_oct(s, 4, &numlen);
SvREFCNT_dec(nrs);
if (rschar & ~((U8)~0))
nrs = newSVpv(&ch, 1);
}
return s + numlen;
+ }
case 'F':
minus_F = TRUE;
splitstr = savepv(s + 1);
return s;
case 'h':
usage(origargv[0]);
- exit(0);
+ PerlProc_exit(0);
case 'i':
if (inplace)
Safefree(inplace);
s += numlen;
}
else {
+ dTHR;
if (RsPARA(nrs)) {
ors = "\n\n";
orslen = 2;
#endif
#ifdef DJGPP
printf("djgpp v2 port (jpl5003c) by Hirofumi Watanabe, 1996\n");
+ printf("djgpp v2 port (perl5004) by Laszlo Molnar, 1997\n");
#endif
#ifdef OS2
printf("\n\nOS/2 port Copyright (c) 1990, 1991, Raymond Chen, Kai Uwe Rommel\n"
printf("\n\
Perl may be copied only under the terms of either the Artistic License or the\n\
GNU General Public License, which may be found in the Perl 5.0 source kit.\n\n");
- exit(0);
+ PerlProc_exit(0);
case 'w':
dowarn = TRUE;
s++;
break;
case '-':
case 0:
+#ifdef WIN32
+ case '\r':
+#endif
case '\n':
case '\t':
break;
if (status)
PerlIO_printf(PerlIO_stderr(), "unexec of %s into %s failed!\n",
SvPVX(prog), SvPVX(file));
- exit(status);
+ PerlProc_exit(status);
#else
# ifdef VMS
# include <lib$routines.h>
errgv = gv_HVadd(gv_fetchpv("@", TRUE, SVt_PV));
GvMULTI_on(errgv);
(void)form("%240s",""); /* Preallocate temp - for immediate signals. */
- sv_grow(GvSV(errgv), 240); /* Preallocate - for immediate signals. */
- sv_setpvn(GvSV(errgv), "", 0);
+ sv_grow(ERRSV, 240); /* Preallocate - for immediate signals. */
+ sv_setpvn(ERRSV, "", 0);
curstash = defstash;
compiling.cop_stash = defstash;
debstash = GvHV(gv_fetchpv("DB::", GV_ADDMULTI, SVt_PVHV));
+ globalstash = GvHV(gv_fetchpv("CORE::GLOBAL::", GV_ADDMULTI, SVt_PVHV));
/* We must init $/ before switches are processed. */
sv_setpvn(GvSV(gv_fetchpv("/", TRUE, SVt_PV)), "\n", 1);
}
*
* Assuming SEARCH_EXTS is C<".foo",".bar",NULL>, PATH search
* proceeds as follows:
- * If DOSISH:
+ * If DOSISH or VMSISH:
* + look for ./scriptname{,.foo,.bar}
* + search the PATH for scriptname{,.foo,.bar}
*
*/
#ifdef VMS
+# ifdef ALWAYS_DEFTYPES
+ len = strlen(scriptname);
+ if (!(len == 1 && *scriptname == '-') && scriptname[len-1] != ':') {
+ int hasdir, idx = 0, deftypes = 1;
+ bool seen_dot = 1;
+
+ hasdir = !dosearch || (strpbrk(scriptname,":[</") != Nullch) ;
+# else
if (dosearch) {
int hasdir, idx = 0, deftypes = 1;
bool seen_dot = 1;
hasdir = (strpbrk(scriptname,":[</") != Nullch) ;
+# endif
/* The first time through, just add SEARCH_EXTS to whatever we
* already have, so we can check for default file types. */
while (deftypes ||
#ifdef DOSISH
&& !strchr(scriptname, '\\')
#endif
- && (s = getenv("PATH"))) {
+ && (s = PerlEnv_getenv("PATH"))) {
bool seen_dot = 0;
bufend = s + strlen(s);
if (strEQ(origfilename,"-"))
scriptname = "";
if (fdscript >= 0) {
- rsfp = PerlIO_fdopen(fdscript,"r");
+ rsfp = PerlIO_fdopen(fdscript,PERL_SCRIPT_MODE);
#if defined(HAS_FCNTL) && defined(F_SETFD)
if (rsfp)
fcntl(PerlIO_fileno(rsfp),F_SETFD,1); /* ensure close-on-exec */
croak("Can't do seteuid!\n");
}
#endif /* IAMSUID */
- rsfp = my_popen(SvPVX(cmd), "r");
+ rsfp = PerlProc_popen(SvPVX(cmd), "r");
SvREFCNT_dec(cmd);
SvREFCNT_dec(cpp);
}
rsfp = PerlIO_stdin();
}
else {
- rsfp = PerlIO_open(scriptname,"r");
+ rsfp = PerlIO_open(scriptname,PERL_SCRIPT_MODE);
#if defined(HAS_FCNTL) && defined(F_SETFD)
if (rsfp)
fcntl(PerlIO_fileno(rsfp),F_SETFD,1); /* ensure close-on-exec */
if (euid && Stat(SvPVX(GvSV(curcop->cop_filegv)),&statbuf) >= 0 &&
statbuf.st_mode & (S_ISUID|S_ISGID)) {
/* try again */
- execv(form("%s/sperl%s", BIN_EXP, patchlevel), origargv);
+ PerlProc_execv(form("%s/sperl%s", BIN_EXP, patchlevel), origargv);
croak("Can't do setuid\n");
}
#endif
dTHR;
char *s, *s2;
- if (Fstat(PerlIO_fileno(rsfp),&statbuf) < 0) /* normal stat is insecure */
+ if (PerlLIO_fstat(PerlIO_fileno(rsfp),&statbuf) < 0) /* normal stat is insecure */
croak("Can't stat script \"%s\"",origfilename);
if (fdscript < 0 && statbuf.st_mode & (S_ISUID|S_ISGID)) {
I32 len;
* But I don't think it's too important. The manual lies when
* it says access() is useful in setuid programs.
*/
- if (access(SvPVX(GvSV(curcop->cop_filegv)),1)) /*double check*/
+ if (PerlLIO_access(SvPVX(GvSV(curcop->cop_filegv)),1)) /*double check*/
croak("Permission denied");
#else
/* If we can swap euid and uid, then we can determine access rights
if (tmpstatbuf.st_dev != statbuf.st_dev ||
tmpstatbuf.st_ino != statbuf.st_ino) {
(void)PerlIO_close(rsfp);
- if (rsfp = my_popen("/bin/mail root","w")) { /* heh, heh */
+ if (rsfp = PerlProc_popen("/bin/mail root","w")) { /* heh, heh */
PerlIO_printf(rsfp,
"User %ld tried to run dev %ld ino %ld in place of dev %ld ino %ld!\n\
(Filename of set-id script was %s, uid %ld gid %ld.)\n\nSincerely,\nperl\n",
(long)statbuf.st_dev, (long)statbuf.st_ino,
SvPVX(GvSV(curcop->cop_filegv)),
(long)statbuf.st_uid, (long)statbuf.st_gid);
- (void)my_pclose(rsfp);
+ (void)PerlProc_pclose(rsfp);
}
croak("Permission denied\n");
}
(void)PerlIO_close(rsfp);
#ifndef IAMSUID
/* try again */
- execv(form("%s/sperl%s", BIN_EXP, patchlevel), origargv);
+ PerlProc_execv(form("%s/sperl%s", BIN_EXP, patchlevel), origargv);
#endif
croak("Can't do setuid\n");
}
/* exec the real perl, substituting fd script for scriptname. */
/* (We pass script name as "subdir" of fd, which perl will grok.) */
PerlIO_rewind(rsfp);
- lseek(PerlIO_fileno(rsfp),(Off_t)0,0); /* just in case rewind didn't */
+ PerlLIO_lseek(PerlIO_fileno(rsfp),(Off_t)0,0); /* just in case rewind didn't */
for (which = 1; origargv[which] && origargv[which] != scriptname; which++) ;
if (!origargv[which])
croak("Permission denied");
#if defined(HAS_FCNTL) && defined(F_SETFD)
fcntl(PerlIO_fileno(rsfp),F_SETFD,0); /* ensure no close-on-exec */
#endif
- execv(form("%s/perl%s", BIN_EXP, patchlevel), origargv); /* try again */
+ PerlProc_execv(form("%s/perl%s", BIN_EXP, patchlevel), origargv); /* try again */
croak("Can't do setuid\n");
#endif /* IAMSUID */
#else /* !DOSUID */
if (euid != uid || egid != gid) { /* (suidperl doesn't exist, in fact) */
#ifndef SETUID_SCRIPTS_ARE_SECURE_NOW
dTHR;
- Fstat(PerlIO_fileno(rsfp),&statbuf); /* may be either wrapped or real suid */
+ PerlLIO_fstat(PerlIO_fileno(rsfp),&statbuf); /* may be either wrapped or real suid */
if ((euid != uid && euid == statbuf.st_uid && statbuf.st_mode & S_ISUID)
||
(egid != gid && egid == statbuf.st_gid && statbuf.st_mode & S_ISGID)
/*SUPPRESS 530*/
while (s = moreswitches(s)) ;
}
- if (cddir && chdir(cddir) < 0)
+ if (cddir && PerlDir_chdir(cddir) < 0)
croak("Can't chdir to %s",cddir);
}
}
stack_sp = stack_base;
stack_max = stack_base + 127;
- cxstack_max = 8192 / sizeof(CONTEXT) - 2; /* Use most of 8K. */
- New(50,cxstack,cxstack_max + 1,CONTEXT);
+ cxstack_max = 8192 / sizeof(PERL_CONTEXT) - 2; /* Use most of 8K. */
+ New(50,cxstack,cxstack_max + 1,PERL_CONTEXT);
cxstack_ix = -1;
New(50,tmps_stack,128,SV*);
GV *tmpgv;
GV *othergv;
+#ifdef USE_THREADS
+ sv_setpvn(*av_fetch(thr->threadsv,find_threadsv("\""),FALSE)," ", 1);
+#else
sv_setpvn(GvSV(gv_fetchpv("\"", TRUE, SVt_PV)), " ", 1);
+#endif /* USE_THREADS */
stdingv = gv_fetchpv("STDIN",TRUE, SVt_PVIO);
GvMULTI_on(stdingv);
static void
init_postdump_symbols(register int argc, register char **argv, register char **env)
{
+ dTHR;
char *s;
SV *sv;
GV* tmpgv;
if (!(s = strchr(*env,'=')))
continue;
*s++ = '\0';
-#ifdef WIN32
+#if defined(WIN32) || defined(MSDOS)
(void)strupr(*env);
#endif
sv = newSVpv(s--,0);
*s = '=';
#if defined(__BORLANDC__) && defined(USE_WIN32_RTL_ENV)
/* Sins of the RTL. See note in my_setenv(). */
- (void)putenv(savepv(*env));
+ (void)PerlEnv_putenv(savepv(*env));
#endif
}
#endif
char *s;
if (!tainting) {
#ifndef VMS
- s = getenv("PERL5LIB");
+ s = PerlEnv_getenv("PERL5LIB");
if (s)
incpush(s, TRUE);
else
- incpush(getenv("PERLLIB"), FALSE);
+ incpush(PerlEnv_getenv("PERLLIB"), 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
SvREFCNT_dec(subdir);
}
+#ifdef USE_THREADS
+static struct perl_thread *
+init_main_thread()
+{
+ struct perl_thread *thr;
+ XPV *xpv;
+
+ Newz(53, thr, 1, struct perl_thread);
+ curcop = &compiling;
+ thr->cvcache = newHV();
+ thr->threadsv = newAV();
+ thr->specific = newAV();
+ thr->errhv = newHV();
+ thr->flags = THRf_R_JOINABLE;
+ MUTEX_INIT(&thr->mutex);
+ /* Handcraft thrsv similarly to mess_sv */
+ New(53, thrsv, 1, SV);
+ Newz(53, xpv, 1, XPV);
+ SvFLAGS(thrsv) = SVt_PV;
+ SvANY(thrsv) = (void*)xpv;
+ SvREFCNT(thrsv) = 1 << 30; /* practically infinite */
+ SvPVX(thrsv) = (char*)thr;
+ SvCUR_set(thrsv, sizeof(thr));
+ SvLEN_set(thrsv, sizeof(thr));
+ *SvEND(thrsv) = '\0'; /* in the trailing_nul field */
+ thr->oursv = thrsv;
+ curcop = &compiling;
+ chopset = " \n-";
+
+ MUTEX_LOCK(&threads_mutex);
+ nthreads++;
+ thr->tid = 0;
+ thr->next = thr;
+ thr->prev = thr;
+ MUTEX_UNLOCK(&threads_mutex);
+
+#ifdef HAVE_THREAD_INTERN
+ init_thread_intern(thr);
+#endif
+
+#ifdef SET_THREAD_SELF
+ SET_THREAD_SELF(thr);
+#else
+ thr->self = pthread_self();
+#endif /* SET_THREAD_SELF */
+ SET_THR(thr);
+
+ /*
+ * These must come after the SET_THR because sv_setpvn does
+ * SvTAINT and the taint fields require dTHR.
+ */
+ toptarget = NEWSV(0,0);
+ sv_upgrade(toptarget, SVt_PVFM);
+ sv_setpvn(toptarget, "", 0);
+ bodytarget = NEWSV(0,0);
+ sv_upgrade(bodytarget, SVt_PVFM);
+ sv_setpvn(bodytarget, "", 0);
+ formtarget = bodytarget;
+ thr->errsv = newSVpv("", 0);
+ return thr;
+}
+#endif /* USE_THREADS */
+
void
call_list(I32 oldscope, AV *list)
{
dJMPENV;
int ret;
- while (AvFILL(list) >= 0) {
+ while (AvFILL(list) >= 0) {
CV *cv = (CV*)av_shift(list);
SAVEFREESV(cv);
JMPENV_PUSH(ret);
switch (ret) {
case 0: {
- SV* atsv = GvSV(errgv);
+ SV* atsv = ERRSV;
PUSHMARK(stack_sp);
perl_call_sv((SV*)cv, G_EVAL|G_DISCARD);
(void)SvPV(atsv, len);
dTHR;
#ifdef USE_THREADS
- DEBUG_L(PerlIO_printf(Perl_debug_log, "my_exit: thread 0x%lx, status %lu\n",
- (unsigned long) thr, (unsigned long) status));
+ DEBUG_L(PerlIO_printf(Perl_debug_log, "my_exit: thread %p, status %lu\n",
+ thr, (unsigned long) status));
#endif /* USE_THREADS */
switch (status) {
case 0:
my_exit_jump(void)
{
dTHR;
- register CONTEXT *cx;
+ register PERL_CONTEXT *cx;
I32 gimme;
SV **newsp;
JMPENV_JUMP(2);
}
+
+
+
https://perl5.git.perl.org / perl5.git / blobdiff