summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--embed.h9
-rw-r--r--ext/Thread/Thread.xs2
-rw-r--r--interp.sym3
-rw-r--r--mg.c4
-rw-r--r--op.c4
-rw-r--r--perl.c39
-rw-r--r--perl.h11
-rw-r--r--pp_ctl.c22
-rw-r--r--pp_sys.c22
-rw-r--r--thread.h2
-rw-r--r--toke.c2
-rw-r--r--util.c2
12 files changed, 70 insertions, 52 deletions
diff --git a/embed.h b/embed.h
index 762ce18fab..0101ca8ad8 100644
--- a/embed.h
+++ b/embed.h
@@ -1264,8 +1264,7 @@
#define e_tmpname (curinterp->Ie_tmpname)
#define endav (curinterp->Iendav)
#define envgv (curinterp->Ienvgv)
-#define errhv (curinterp->Ierrhv)
-#define errsv (curinterp->Ierrsv)
+#define errgv (curinterp->Ierrgv)
#define eval_root (curinterp->Ieval_root)
#define eval_start (curinterp->Ieval_start)
#define fdpid (curinterp->Ifdpid)
@@ -1417,8 +1416,7 @@
#define Ie_tmpname e_tmpname
#define Iendav endav
#define Ienvgv envgv
-#define Ierrhv errhv
-#define Ierrsv errsv
+#define Ierrgv errgv
#define Ieval_root eval_root
#define Ieval_start eval_start
#define Ifdpid fdpid
@@ -1579,8 +1577,7 @@
#define e_fp Perl_e_fp
#define e_tmpname Perl_e_tmpname
#define endav Perl_endav
-#define errhv Perl_errhv
-#define errsv Perl_errsv
+#define errgv Perl_errgv
#define eval_root Perl_eval_root
#define eval_start Perl_eval_start
#define fdpid Perl_fdpid
diff --git a/ext/Thread/Thread.xs b/ext/Thread/Thread.xs
index 9c0325e07d..f5bb2220b2 100644
--- a/ext/Thread/Thread.xs
+++ b/ext/Thread/Thread.xs
@@ -147,6 +147,8 @@ void *arg;
SvREFCNT_dec(thr->cvcache);
SvREFCNT_dec(thr->magicals);
SvREFCNT_dec(thr->specific);
+ SvREFCNT_dec(thr->errsv);
+ SvREFCNT_dec(thr->errhv);
Safefree(markstack);
Safefree(scopestack);
Safefree(savestack);
diff --git a/interp.sym b/interp.sym
index ae064a8031..1583ea217e 100644
--- a/interp.sym
+++ b/interp.sym
@@ -47,8 +47,7 @@ e_fp
e_tmpname
endav
envgv
-errhv
-errsv
+errgv
eval_root
eval_start
fdpid
diff --git a/mg.c b/mg.c
index 47e05a1176..15005e075e 100644
--- a/mg.c
+++ b/mg.c
@@ -580,7 +580,7 @@ MAGIC *mg;
break;
#ifdef USE_THREADS
case '@':
- sv_setsv(sv, errsv);
+ sv_setsv(sv, thr->errsv);
break;
#endif /* USE_THREADS */
}
@@ -1719,7 +1719,7 @@ MAGIC* mg;
break;
#ifdef USE_THREADS
case '@':
- sv_setsv(errsv, sv);
+ sv_setsv(thr->errsv, sv);
break;
#endif /* USE_THREADS */
}
diff --git a/op.c b/op.c
index 3bd44fc280..06f027c49f 100644
--- a/op.c
+++ b/op.c
@@ -3487,8 +3487,8 @@ OP *block;
croak(not_safe);
else {
/* force display of errors found but not reported */
- sv_catpv(errsv, not_safe);
- croak("%s", SvPV(errsv, na));
+ sv_catpv(ERRSV, not_safe);
+ croak("%s", SvPVx(ERRSV, na));
}
}
}
diff --git a/perl.c b/perl.c
index fff0450593..dce37a4a5f 100644
--- a/perl.c
+++ b/perl.c
@@ -470,8 +470,7 @@ register PerlInterpreter *sv_interp;
envgv = Nullgv;
siggv = Nullgv;
incgv = Nullgv;
- errhv = Nullhv;
- errsv = Nullsv;
+ errgv = Nullgv;
argvgv = Nullgv;
argvoutgv = Nullgv;
stdingv = Nullgv;
@@ -1087,6 +1086,13 @@ perl_get_sv(name, create)
char* name;
I32 create;
{
+#ifdef USE_THREADS
+ PADOFFSET tmp;
+ if (name[1] == '\0' && !isALPHA(name[0])
+ && (tmp = find_thread_magical(name)) != NOT_IN_PAD) {
+ return *av_fetch(thr->magicals, tmp, FALSE);
+ }
+#endif /* USE_THREADS */
GV* gv = gv_fetchpv(name, create, SVt_PV);
if (gv)
return GvSV(gv);
@@ -1247,7 +1253,7 @@ I32 flags; /* See G_* flags in cop.h */
if (flags & G_KEEPERR)
in_eval |= 4;
else
- sv_setpv(errsv,"");
+ sv_setpv(ERRSV,"");
}
markstack_ptr++;
@@ -1292,7 +1298,7 @@ I32 flags; /* See G_* flags in cop.h */
runops();
retval = stack_sp - (stack_base + oldmark);
if ((flags & G_EVAL) && !(flags & G_KEEPERR))
- sv_setpv(errsv,"");
+ sv_setpv(ERRSV,"");
cleanup:
if (flags & G_EVAL) {
@@ -1401,7 +1407,7 @@ I32 flags; /* See G_* flags in cop.h */
runops();
retval = stack_sp - (stack_base + oldmark);
if (!(flags & G_KEEPERR))
- sv_setpv(errsv,"");
+ sv_setpv(ERRSV,"");
cleanup:
JMPENV_POP;
@@ -1432,8 +1438,8 @@ I32 croak_on_error;
sv = POPs;
PUTBACK;
- if (croak_on_error && SvTRUE(errsv))
- croak(SvPV(errsv, na));
+ if (croak_on_error && SvTRUE(ERRSV))
+ croak(SvPVx(ERRSV, na));
return sv;
}
@@ -1804,11 +1810,11 @@ init_main_stash()
incgv = gv_HVadd(gv_AVadd(gv_fetchpv("INC",TRUE, SVt_PVAV)));
GvMULTI_on(incgv);
defgv = gv_fetchpv("_",TRUE, SVt_PVAV);
- errsv = newSVpv("", 0);
- errhv = newHV();
+ errgv = gv_HVadd(gv_fetchpv("@", TRUE, SVt_PV));
+ GvMULTI_on(errgv);
(void)form("%240s",""); /* Preallocate temp - for immediate signals. */
- sv_grow(errsv, 240); /* Preallocate - for immediate signals. */
- sv_setpvn(errsv, "", 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));
@@ -2840,6 +2846,8 @@ init_main_thread()
thr->cvcache = newHV();
thr->magicals = newAV();
thr->specific = newAV();
+ thr->errsv = newSVpv("", 0);
+ thr->errhv = newHV();
thr->flags = THRf_R_JOINABLE;
MUTEX_INIT(&thr->mutex);
/* Handcraft thrsv similarly to mess_sv */
@@ -2904,20 +2912,21 @@ AV* list;
JMPENV_PUSH(ret);
switch (ret) {
case 0: {
+ SV* atsv = ERRSV;
PUSHMARK(stack_sp);
perl_call_sv((SV*)cv, G_EVAL|G_DISCARD);
- (void)SvPV(errsv, len);
+ (void)SvPV(atsv, len);
if (len) {
JMPENV_POP;
curcop = &compiling;
curcop->cop_line = oldline;
if (list == beginav)
- sv_catpv(errsv, "BEGIN failed--compilation aborted");
+ sv_catpv(atsv, "BEGIN failed--compilation aborted");
else
- sv_catpv(errsv, "END failed--cleanup aborted");
+ sv_catpv(atsv, "END failed--cleanup aborted");
while (scopestack_ix > oldscope)
LEAVE;
- croak("%s", SvPVX(errsv));
+ croak("%s", SvPVX(atsv));
}
}
break;
diff --git a/perl.h b/perl.h
index 09cb1d6b87..c344105725 100644
--- a/perl.h
+++ b/perl.h
@@ -461,6 +461,14 @@ typedef pthread_key_t perl_key;
# define SETERRNO(errcode,vmserrcode) errno = (errcode)
#endif
+#ifdef USE_THREADS
+# define ERRSV (thr->errsv)
+# define ERRHV (thr->errhv)
+#else
+# define ERRSV GvSV(errgv)
+# define ERRHV GvHV(errgv)
+#endif /* USE_THREADS */
+
#ifndef errno
extern int errno; /* ANSI allows errno to be an lvalue expr */
#endif
@@ -1859,8 +1867,7 @@ IEXT I32 Imaxscream IINIT(-1);
IEXT SV * Ilastscream;
/* shortcuts to misc objects */
-IEXT HV * Ierrhv;
-IEXT SV * Ierrsv;
+IEXT GV * Ierrgv;
/* shortcuts to debugging objects */
IEXT GV * IDBgv;
diff --git a/pp_ctl.c b/pp_ctl.c
index 915ee6c588..7eb013cf1c 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -1040,21 +1040,21 @@ char *message;
SV **svp;
STRLEN klen = strlen(message);
- svp = hv_fetch(errhv, message, klen, TRUE);
+ svp = hv_fetch(ERRHV, message, klen, TRUE);
if (svp) {
if (!SvIOK(*svp)) {
static char prefix[] = "\t(in cleanup) ";
sv_upgrade(*svp, SVt_IV);
(void)SvIOK_only(*svp);
- SvGROW(errsv, SvCUR(errsv)+sizeof(prefix)+klen);
- sv_catpvn(errsv, prefix, sizeof(prefix)-1);
- sv_catpvn(errsv, message, klen);
+ SvGROW(ERRSV, SvCUR(ERRSV)+sizeof(prefix)+klen);
+ sv_catpvn(ERRSV, prefix, sizeof(prefix)-1);
+ sv_catpvn(ERRSV, message, klen);
}
sv_inc(*svp);
}
}
else
- sv_setpv(errsv, message);
+ sv_setpv(ERRSV, message);
cxix = dopoptoeval(cxstack_ix);
if (cxix >= 0) {
@@ -1077,7 +1077,7 @@ char *message;
LEAVE;
if (optype == OP_REQUIRE) {
- char* msg = SvPV(errsv, na);
+ char* msg = SvPVx(ERRSV, na);
DIE("%s", *msg ? msg : "Compilation failed in require");
}
return pop_return();
@@ -2197,7 +2197,7 @@ int gimme;
if (saveop->op_flags & OPf_SPECIAL)
in_eval |= 4;
else
- sv_setpv(errsv,"");
+ sv_setpv(ERRSV,"");
if (yyparse() || error_count || !eval_root) {
SV **newsp;
I32 gimme;
@@ -2216,7 +2216,7 @@ int gimme;
lex_end();
LEAVE;
if (optype == OP_REQUIRE) {
- char* msg = SvPV(errsv, na);
+ char* msg = SvPVx(ERRSV, na);
DIE("%s", *msg ? msg : "Compilation failed in require");
}
SvREFCNT_dec(rs);
@@ -2570,7 +2570,7 @@ PP(pp_leaveeval)
LEAVE;
if (!(save_flags & OPf_SPECIAL))
- sv_setpv(errsv,"");
+ sv_setpv(ERRSV,"");
RETURNOP(retop);
}
@@ -2590,7 +2590,7 @@ PP(pp_entertry)
eval_root = op; /* Only needed so that goto works right. */
in_eval = 1;
- sv_setpv(errsv,"");
+ sv_setpv(ERRSV,"");
PUTBACK;
return DOCATCH(op->op_next);
}
@@ -2638,7 +2638,7 @@ PP(pp_leavetry)
curpm = newpm; /* Don't pop $1 et al till now */
LEAVE;
- sv_setpv(errsv,"");
+ sv_setpv(ERRSV,"");
RETURN;
}
diff --git a/pp_sys.c b/pp_sys.c
index 5eaa1e19d9..77dd6180c3 100644
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -278,10 +278,10 @@ PP(pp_warn)
tmps = SvPV(TOPs, na);
}
if (!tmps || !*tmps) {
- (void)SvUPGRADE(errsv, SVt_PV);
- if (SvPOK(errsv) && SvCUR(errsv))
- sv_catpv(errsv, "\t...caught");
- tmps = SvPV(errsv, na);
+ (void)SvUPGRADE(ERRSV, SVt_PV);
+ if (SvPOK(ERRSV) && SvCUR(ERRSV))
+ sv_catpv(ERRSV, "\t...caught");
+ tmps = SvPV(ERRSV, na);
}
if (!tmps || !*tmps)
tmps = "Warning: something's wrong";
@@ -303,10 +303,10 @@ PP(pp_die)
tmps = SvPV(TOPs, na);
}
if (!tmps || !*tmps) {
- (void)SvUPGRADE(errsv, SVt_PV);
- if (SvPOK(errsv) && SvCUR(errsv))
- sv_catpv(errsv, "\t...propagated");
- tmps = SvPV(errsv, na);
+ (void)SvUPGRADE(ERRSV, SVt_PV);
+ if (SvPOK(ERRSV) && SvCUR(ERRSV))
+ sv_catpv(ERRSV, "\t...propagated");
+ tmps = SvPV(ERRSV, na);
}
if (!tmps || !*tmps)
tmps = "Died";
@@ -550,7 +550,7 @@ PP(pp_tie)
CATCH_SET(oldcatch);
#else
ENTER;
- perl_call_sv((SV*)gv, G_SCALAR);
+ perl_call_sv((SV*)GvCV(gv), G_SCALAR);
SPAGAIN;
#endif
sv = TOPs;
@@ -680,7 +680,7 @@ PP(pp_dbmopen)
runops();
#else
PUTBACK;
- perl_call_sv((SV*)gv, G_SCALAR);
+ perl_call_sv((SV*)GvCV(gv), G_SCALAR);
#endif
SPAGAIN;
@@ -707,7 +707,7 @@ PP(pp_dbmopen)
if (op = pp_entersub(ARGS))
runops();
#else
- perl_call_sv((SV*)gv, G_SCALAR);
+ perl_call_sv((SV*)GvCV(gv), G_SCALAR);
#endif
SPAGAIN;
}
diff --git a/thread.h b/thread.h
index 305155c3ff..79064e494e 100644
--- a/thread.h
+++ b/thread.h
@@ -219,6 +219,8 @@ struct thread {
U32 flags;
AV * magicals; /* Per-thread magicals */
AV * specific; /* Thread-specific user data */
+ SV * errsv; /* Backing SV for $@ */
+ HV * errhv; /* HV for what was %@ in pp_ctl.c */
perl_mutex mutex; /* For the fields others can change */
U32 tid;
struct thread *next, *prev; /* Circular linked list of threads */
diff --git a/toke.c b/toke.c
index 6c53b99dd5..5ba993c523 100644
--- a/toke.c
+++ b/toke.c
@@ -5431,7 +5431,7 @@ char *s;
if (in_eval & 2)
warn("%_", msg);
else if (in_eval)
- sv_catsv(errsv, msg);
+ sv_catsv(ERRSV, msg);
else
PerlIO_write(PerlIO_stderr(), SvPVX(msg), SvCUR(msg));
if (++error_count >= 10)
diff --git a/util.c b/util.c
index 72c76a0ade..b6b27a6b16 100644
--- a/util.c
+++ b/util.c
@@ -2530,6 +2530,8 @@ struct thread *t;
thr->cvcache = newHV();
thr->magicals = newAV();
thr->specific = newAV();
+ thr->errsv = newSVpv("", 0);
+ thr->errhv = newHV();
thr->flags = THRf_R_JOINABLE;
MUTEX_INIT(&thr->mutex);
View Lorry Controller Status