From 38a03e6ea6b9b346c41b9006fbeedc3b0f0130b2 Mon Sep 17 00:00:00 2001 From: Malcolm Beattie Date: Tue, 11 Nov 1997 12:48:26 +0000 Subject: Fix up $@ (ERRSV now refers to GvSV(errgv) for non-threaded perl and thr->errsv for threaded perl). Fix pp_tie and pp_dbmopen to use GvCV(gv) instead of gv so AUTOLOAD stuff works. All tests now pass again for non-threaded perl. Enhanced perl_get_sv to return per-thread magicals where necessary for threaded perl. p4raw-id: //depot/perl@228 --- embed.h | 9 +++------ ext/Thread/Thread.xs | 2 ++ interp.sym | 3 +-- mg.c | 4 ++-- op.c | 4 ++-- perl.c | 39 ++++++++++++++++++++++++--------------- perl.h | 11 +++++++++-- pp_ctl.c | 22 +++++++++++----------- pp_sys.c | 22 +++++++++++----------- thread.h | 2 ++ toke.c | 2 +- util.c | 2 ++ 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); -- cgit v1.2.1