diff options
-rw-r--r-- | ext/Thread/Thread.xs | 1 | ||||
-rw-r--r-- | perl.c | 1 | ||||
-rw-r--r-- | perl.h | 4 | ||||
-rw-r--r-- | pp_ctl.c | 37 | ||||
-rw-r--r-- | thrdvar.h | 1 | ||||
-rw-r--r-- | util.c | 1 |
6 files changed, 20 insertions, 25 deletions
diff --git a/ext/Thread/Thread.xs b/ext/Thread/Thread.xs index 09d063a992..a57f4770b2 100644 --- a/ext/Thread/Thread.xs +++ b/ext/Thread/Thread.xs @@ -159,7 +159,6 @@ threadstart(void *arg) SvREFCNT_dec(thr->threadsv); SvREFCNT_dec(thr->specific); SvREFCNT_dec(thr->errsv); - SvREFCNT_dec(thr->errhv); /*Safefree(cxstack);*/ while (PL_curstackinfo->si_next) @@ -2920,7 +2920,6 @@ S_init_main_thread(pTHX) 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 */ @@ -684,16 +684,16 @@ Free_t Perl_mfree (Malloc_t where); #ifdef USE_THREADS # define ERRSV (thr->errsv) -# define ERRHV (thr->errhv) # define DEFSV THREADSV(0) # define SAVE_DEFSV save_threadsv(0) #else # define ERRSV GvSV(PL_errgv) -# define ERRHV GvHV(PL_errgv) # define DEFSV GvSV(PL_defgv) # define SAVE_DEFSV SAVESPTR(GvSV(PL_defgv)) #endif /* USE_THREADS */ +#define ERRHV GvHV(PL_errgv) /* XXX unused, here for compatibility */ + #ifndef errno extern int errno; /* ANSI allows errno to be an lvalue expr. * For example in multithreaded environments @@ -1272,26 +1272,25 @@ Perl_die_where(pTHX_ char *message, STRLEN msglen) if (message) { if (PL_in_eval & EVAL_KEEPERR) { - SV **svp; - - svp = hv_fetch(ERRHV, message, msglen, TRUE); - if (svp) { - if (!SvIOK(*svp)) { - static char prefix[] = "\t(in cleanup) "; - SV *err = ERRSV; - sv_upgrade(*svp, SVt_IV); - (void)SvIOK_only(*svp); - if (!SvPOK(err)) - sv_setpv(err,""); - SvGROW(err, SvCUR(err)+sizeof(prefix)+msglen); - sv_catpvn(err, prefix, sizeof(prefix)-1); - sv_catpvn(err, message, msglen); - if (ckWARN(WARN_UNSAFE)) { - STRLEN start = SvCUR(err)-msglen-sizeof(prefix)+1; - Perl_warner(aTHX_ WARN_UNSAFE, SvPVX(err)+start); - } + static char prefix[] = "\t(in cleanup) "; + SV *err = ERRSV; + char *e = Nullch; + if (!SvPOK(err)) + sv_setpv(err,""); + else if (SvCUR(err) >= sizeof(prefix)+msglen-1) { + e = SvPV(err, n_a); + e += n_a - msglen; + if (*e != *message || strNE(e,message)) + e = Nullch; + } + if (!e) { + SvGROW(err, SvCUR(err)+sizeof(prefix)+msglen); + sv_catpvn(err, prefix, sizeof(prefix)-1); + sv_catpvn(err, message, msglen); + if (ckWARN(WARN_UNSAFE)) { + STRLEN start = SvCUR(err)-msglen-sizeof(prefix)+1; + Perl_warner(aTHX_ WARN_UNSAFE, SvPVX(err)+start); } - sv_inc(*svp); } } else @@ -213,7 +213,6 @@ PERLVAR(threadsv, AV *) /* Per-thread SVs ($_, $@ etc.) */ PERLVAR(threadsvp, SV **) /* AvARRAY(threadsv) */ PERLVAR(specific, AV *) /* Thread-specific user data */ PERLVAR(errsv, SV *) /* Backing SV for $@ */ -PERLVAR(errhv, HV *) /* HV for what was %@ in pp_ctl.c */ PERLVAR(mutex, perl_mutex) /* For the fields others can change */ PERLVAR(tid, U32) PERLVAR(prev, struct perl_thread *) @@ -3393,7 +3393,6 @@ Perl_new_struct_thread(pTHX_ struct perl_thread *t) thr->threadsv = newAV(); thr->specific = newAV(); thr->errsv = newSVpvn("", 0); - thr->errhv = newHV(); thr->flags = THRf_R_JOINABLE; MUTEX_INIT(&thr->mutex); |