diff options
| -rw-r--r-- | dosish.h | 1 | ||||
| -rw-r--r-- | embedvar.h | 3 | ||||
| -rw-r--r-- | ext/Thread/Thread.xs | 32 | ||||
| -rw-r--r-- | interp.sym | 1 | ||||
| -rw-r--r-- | intrpvar.h | 1 | ||||
| -rw-r--r-- | op.c | 1 | ||||
| -rw-r--r-- | perl.c | 7 | ||||
| -rw-r--r-- | perl.h | 9 | ||||
| -rw-r--r-- | pp.c | 2 | ||||
| -rw-r--r-- | pp_ctl.c | 2 | ||||
| -rw-r--r-- | scope.c | 2 | ||||
| -rw-r--r-- | sv.c | 36 | ||||
| -rw-r--r-- | thrdvar.h | 1 | ||||
| -rw-r--r-- | thread.h | 41 | ||||
| -rw-r--r-- | util.c | 11 |
15 files changed, 91 insertions, 59 deletions
@@ -28,7 +28,6 @@ } STMT_END # define pthread_mutexattr_default NULL # define pthread_condattr_default NULL -# define pthread_attr_default NULL # define pthread_addr_t any_t # endif #else /* DJGPP */ diff --git a/embedvar.h b/embedvar.h index f2f7f690c7..d11686ca34 100644 --- a/embedvar.h +++ b/embedvar.h @@ -189,6 +189,7 @@ #define sv_objcount (curinterp->Isv_objcount) #define sv_root (curinterp->Isv_root) #define tainting (curinterp->Itainting) +#define threadnum (curinterp->Ithreadnum) #define thrsv (curinterp->Ithrsv) #define unsafe (curinterp->Iunsafe) #define warnhook (curinterp->Iwarnhook) @@ -306,6 +307,7 @@ #define Isv_objcount sv_objcount #define Isv_root sv_root #define Itainting tainting +#define Ithreadnum threadnum #define Ithrsv thrsv #define Iunsafe unsafe #define Iwarnhook warnhook @@ -483,6 +485,7 @@ #define sv_objcount Perl_sv_objcount #define sv_root Perl_sv_root #define tainting Perl_tainting +#define threadnum Perl_threadnum #define thrsv Perl_thrsv #define unsafe Perl_unsafe #define warnhook Perl_warnhook diff --git a/ext/Thread/Thread.xs b/ext/Thread/Thread.xs index c5adcb3eb7..3b49dbecb2 100644 --- a/ext/Thread/Thread.xs +++ b/ext/Thread/Thread.xs @@ -12,7 +12,6 @@ #endif #include <fcntl.h> -static U32 threadnum = 0; static int sig_pipe[2]; #ifndef THREAD_RET_TYPE @@ -208,6 +207,8 @@ newthread (SV *startsv, AV *initargs, char *classname) SV *sv; int err; #ifndef THREAD_CREATE + static pthread_attr_t attr; + static int attr_inited = 0; sigset_t fullmask, oldmask; #endif @@ -233,33 +234,22 @@ newthread (SV *startsv, AV *initargs, char *classname) sigfillset(&fullmask); if (sigprocmask(SIG_SETMASK, &fullmask, &oldmask) == -1) croak("panic: sigprocmask"); -#ifdef PTHREADS_CREATED_JOINABLE - err = pthread_create(&thr->self, pthread_attr_default, - threadstart, (void*) thr); -#else - { - pthread_attr_t attr; - + err = 0; + if (!attr_inited) { + attr_inited = 1; err = pthread_attr_init(&attr); - if (err == 0) { -#ifdef PTHREAD_CREATE_UNDETACHED - err = pthread_attr_setdetachstate(&attr, PTHREAD_CREATE_UNDETACHED); -#else - croak("panic: pthread_attr_setdetachstate"); -#endif - if (err == 0) - err = pthread_create(&thr->self, &attr, - threadstart, (void*) thr); - } - pthread_attr_destroy(&attr); + if (err == 0) + err = pthread_attr_setdetachstate(&attr, ATTR_JOINABLE); } -#endif + if (err == 0) + err = pthread_create(&thr->self, &attr, threadstart, (void*) thr); /* Go */ MUTEX_UNLOCK(&thr->mutex); #endif if (err) { DEBUG_L(PerlIO_printf(PerlIO_stderr(), - "%p: create of %p failed %d\n", savethread, thr, err)); + "%p: create of %p failed %d\n", + savethread, thr, err)); /* Thread creation failed--clean up */ SvREFCNT_dec(thr->cvcache); remove_thread(thr); diff --git a/interp.sym b/interp.sym index e95a9162c4..5453afa064 100644 --- a/interp.sym +++ b/interp.sym @@ -134,6 +134,7 @@ sv_root sv_arenaroot tainted tainting +threadnum thrsv tmps_floor tmps_ix diff --git a/intrpvar.h b/intrpvar.h index f3014cbb14..be081be3d5 100644 --- a/intrpvar.h +++ b/intrpvar.h @@ -156,4 +156,5 @@ PERLVAR(Iofmt, char *) /* $# */ #ifdef USE_THREADS PERLVAR(Ithrsv, SV *) /* holds struct perl_thread for main thread */ +PERLVARI(Ithreadnum, U32, 0) /* incremented each thread creation */ #endif /* USE_THREADS */ @@ -514,6 +514,7 @@ find_threadsv(char *name) if (!svp) { SV *sv = NEWSV(0, 0); av_store(thr->threadsv, key, sv); + thr->threadsvp = AvARRAY(thr->threadsv); /* * Some magic variables used to be automagically initialised * in gv_fetchpv. Those which are now per-thread magicals get @@ -936,7 +936,7 @@ print \" \\@INC:\\n @INC\\n\";"); SvREFCNT_dec(rs); rs = SvREFCNT_inc(nrs); #ifdef USE_THREADS - sv_setsv(*av_fetch(thr->threadsv, find_threadsv("/"), FALSE), rs); + sv_setsv(THREADSV(find_threadsv("/")), rs); #else sv_setsv(GvSV(gv_fetchpv("/", TRUE, SVt_PV)), rs); #endif /* USE_THREADS */ @@ -1054,7 +1054,7 @@ perl_get_sv(char *name, I32 create) PADOFFSET tmp = find_threadsv(name); if (tmp != NOT_IN_PAD) { dTHR; - return *av_fetch(thr->threadsv, tmp, FALSE); + return THREADSV(tmp); } } #endif /* USE_THREADS */ @@ -2510,7 +2510,7 @@ init_predump_symbols(void) GV *othergv; #ifdef USE_THREADS - sv_setpvn(*av_fetch(thr->threadsv,find_threadsv("\""),FALSE)," ", 1); + sv_setpvn(THREADSV(find_threadsv("\"")), " ", 1); #else sv_setpvn(GvSV(gv_fetchpv("\"", TRUE, SVt_PV)), " ", 1); #endif /* USE_THREADS */ @@ -2799,6 +2799,7 @@ init_main_thread() curcop = &compiling; thr->cvcache = newHV(); thr->threadsv = newAV(); + /* thr->threadsvp is set when find_threadsv is called */ thr->specific = newAV(); thr->errhv = newHV(); thr->flags = THRf_R_JOINABLE; @@ -471,8 +471,8 @@ Free_t Perl_free _((Malloc_t where)); #ifdef USE_THREADS # define ERRSV (thr->errsv) # define ERRHV (thr->errhv) -# define DEFSV *av_fetch(thr->threadsv, find_threadsv("_"), FALSE) -# define SAVE_DEFSV save_threadsv(find_threadsv("_")) +# define DEFSV THREADSV(0) +# define SAVE_DEFSV save_threadsv(0) #else # define ERRSV GvSV(errgv) # define ERRHV GvHV(errgv) @@ -1379,6 +1379,7 @@ int runops_standard _((void)); int runops_debug _((void)); #endif +/* _ (for $_) must be first in the following list (DEFSV requires it) */ #define THREADSV_NAMES "_123456789&`'+/.,\\\";^-%=|~:\001\005!@" /* VMS doesn't use environ array and NeXT has problems with crt0.o globals */ @@ -2035,12 +2036,12 @@ enum { * and queried under the protection of sv_mutex */ #define offer_nice_chunk(chunk, chunk_size) do { \ - MUTEX_LOCK(&sv_mutex); \ + LOCK_SV_MUTEX; \ if (!nice_chunk) { \ nice_chunk = (char*)(chunk); \ nice_chunk_size = (chunk_size); \ } \ - MUTEX_UNLOCK(&sv_mutex); \ + UNLOCK_SV_MUTEX; \ } while (0) @@ -4314,7 +4314,7 @@ PP(pp_threadsv) if (op->op_private & OPpLVAL_INTRO) PUSHs(*save_threadsv(op->op_targ)); else - PUSHs(*av_fetch(thr->threadsv, op->op_targ, FALSE)); + PUSHs(THREADSV(op->op_targ)); RETURN; #else DIE("tried to access per-thread data in non-threaded perl"); @@ -547,7 +547,7 @@ PP(pp_grepstart) SAVETMPS; #ifdef USE_THREADS /* SAVE_DEFSV does *not* suffice here */ - save_sptr(av_fetch(thr->threadsv, find_threadsv("_"), FALSE)); + save_sptr(&THREADSV(0)); #else SAVESPTR(GvSV(defgv)); #endif /* USE_THREADS */ @@ -335,7 +335,7 @@ save_threadsv(PADOFFSET i) { #ifdef USE_THREADS dTHR; - SV **svp = av_fetch(thr->threadsv, i, FALSE); + SV **svp = &THREADSV(i); /* XXX Change to save by offset */ DEBUG_L(PerlIO_printf(PerlIO_stderr(), "save_threadsv %u: %p %p:%s\n", i, svp, *svp, SvPEEK(*svp))); save_svref(svp); @@ -65,18 +65,18 @@ typedef void (*SVFUNC) _((SV*)); #define new_SV(p) \ do { \ - MUTEX_LOCK(&sv_mutex); \ + LOCK_SV_MUTEX; \ (p) = (SV*)safemalloc(sizeof(SV)); \ reg_add(p); \ - MUTEX_UNLOCK(&sv_mutex); \ + UNLOCK_SV_MUTEX; \ } while (0) #define del_SV(p) \ do { \ - MUTEX_LOCK(&sv_mutex); \ + LOCK_SV_MUTEX; \ reg_remove(p); \ free((char*)(p)); \ - MUTEX_UNLOCK(&sv_mutex); \ + UNLOCK_SV_MUTEX; \ } while (0) static SV **registry; @@ -183,24 +183,24 @@ U32 flags; ++sv_count; \ } while (0) -#define new_SV(p) do { \ - MUTEX_LOCK(&sv_mutex); \ - if (sv_root) \ - uproot_SV(p); \ - else \ - (p) = more_sv(); \ - MUTEX_UNLOCK(&sv_mutex); \ +#define new_SV(p) do { \ + LOCK_SV_MUTEX; \ + if (sv_root) \ + uproot_SV(p); \ + else \ + (p) = more_sv(); \ + UNLOCK_SV_MUTEX; \ } while (0) #ifdef DEBUGGING -#define del_SV(p) do { \ - MUTEX_LOCK(&sv_mutex); \ - if (debug & 32768) \ - del_sv(p); \ - else \ - plant_SV(p); \ - MUTEX_UNLOCK(&sv_mutex); \ +#define del_SV(p) do { \ + LOCK_SV_MUTEX; \ + if (debug & 32768) \ + del_sv(p); \ + else \ + plant_SV(p); \ + UNLOCK_SV_MUTEX; \ } while (0) static void @@ -87,6 +87,7 @@ PERLVAR(cvcache, HV *) PERLVAR(self, perl_os_thread) /* Underlying thread object */ PERLVAR(flags, U32) 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 */ @@ -20,10 +20,19 @@ #else # define pthread_mutexattr_default NULL # define pthread_condattr_default NULL -# define pthread_attr_default NULL #endif /* OLD_PTHREADS_API */ #endif +#ifdef PTHREADS_CREATED_JOINABLE +# define ATTR_JOINABLE PTHREAD_CREATE_JOINABLE +#else +# ifdef PTHREAD_CREATE_UNDETACHED +# define ATTR_JOINABLE PTHREAD_CREATE_UNDETACHED +# else +# define ATTR_JOINABLE PTHREAD_CREATE_JOINABLE +# endif +#endif + #ifndef YIELD # ifdef HAS_PTHREAD_YIELD # define YIELD pthread_yield() @@ -119,8 +128,16 @@ struct perl_thread *getTHR _((void)); # endif /* OLD_PTHREADS_API */ #endif /* THR */ +/* + * dTHR is performance-critical. Here, we only do the pthread_get_specific + * if there may be more than one thread in existence, otherwise we get thr + * from thrsv which is cached in the per-interpreter structure. + * Systems with very fast pthread_get_specific (which should be all systems + * but unfortunately isn't) may wish to simplify to "...*thr = THR". + */ #ifndef dTHR -# define dTHR struct perl_thread *thr = THR +# define dTHR \ + struct perl_thread *thr = threadnum? THR : (struct perl_thread*)SvPVX(thrsv) #endif /* dTHR */ #ifndef INIT_THREADS @@ -131,6 +148,26 @@ struct perl_thread *getTHR _((void)); # endif #endif +/* Accessor for per-thread SVs */ +#define THREADSV(i) (thr->threadsvp[i]) + +/* + * LOCK_SV_MUTEX and UNLOCK_SV_MUTEX are performance-critical. Here, we + * try only locking them if there may be more than one thread in existence. + * Systems with very fast mutexes (and/or slow conditionals) may wish to + * remove the "if (threadnum) ..." test. + */ +#define LOCK_SV_MUTEX \ + STMT_START { \ + if (threadnum) \ + MUTEX_LOCK(&sv_mutex); \ + } STMT_END + +#define UNLOCK_SV_MUTEX \ + STMT_START { \ + if (threadnum) \ + MUTEX_UNLOCK(&sv_mutex); \ + } STMT_END #ifndef THREAD_RET_TYPE # define THREAD_RET_TYPE void * @@ -56,10 +56,6 @@ static void xstat _((void)); #endif -#ifdef USE_THREADS -static U32 threadnum = 0; -#endif /* USE_THREADS */ - #ifndef MYMALLOC /* paranoid version of malloc */ @@ -2443,11 +2439,11 @@ condpair_magic(SV *sv) COND_INIT(&cp->owner_cond); COND_INIT(&cp->cond); cp->owner = 0; - MUTEX_LOCK(&sv_mutex); + LOCK_SV_MUTEX; mg = mg_find(sv, 'm'); if (mg) { /* someone else beat us to initialising it */ - MUTEX_UNLOCK(&sv_mutex); + UNLOCK_SV_MUTEX; MUTEX_DESTROY(&cp->mutex); COND_DESTROY(&cp->owner_cond); COND_DESTROY(&cp->cond); @@ -2458,7 +2454,7 @@ condpair_magic(SV *sv) mg = SvMAGIC(sv); mg->mg_ptr = (char *)cp; mg->mg_len = sizeof(cp); - MUTEX_UNLOCK(&sv_mutex); + UNLOCK_SV_MUTEX; DEBUG_L(WITH_THR(PerlIO_printf(PerlIO_stderr(), "%p: condpair_magic %p\n", thr, sv));) } @@ -2552,6 +2548,7 @@ new_struct_thread(struct perl_thread *t) "new_struct_thread: copied threadsv %d %p->%p\n",i, t, thr)); } } + thr->threadsvp = AvARRAY(thr->threadsv); MUTEX_LOCK(&threads_mutex); nthreads++; |