X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/3319632a10023824bc0ba81a0361a84f50be4b44..b41c5839100237b5ac56296e146374b69a8ee83a:/thread.h diff --git a/thread.h b/thread.h index 3a059b5..54d9866 100644 --- a/thread.h +++ b/thread.h @@ -17,32 +17,21 @@ #ifdef WIN32 # include #else -#ifdef NETWARE -# include -#else # ifdef OLD_PTHREADS_API /* Here be dragons. */ # define DETACH(t) \ STMT_START { \ - int _eC_; \ - if ((_eC_ = pthread_detach(&(t)->self))) { \ - MUTEX_UNLOCK(&(t)->mutex); \ - Perl_croak_nocontext("panic: DETACH (%d) [%s:%d]", \ - _eC_, __FILE__, __LINE__); \ - } \ + int _eC_; \ + if ((_eC_ = pthread_detach(&(t)->self))) { \ + MUTEX_UNLOCK(&(t)->mutex); \ + Perl_croak_nocontext("panic: DETACH (%d) [%s:%d]", \ + _eC_, __FILE__, __LINE__); \ + } \ } STMT_END # define PERL_GET_CONTEXT Perl_get_context() # define PERL_SET_CONTEXT(t) Perl_set_context((void*)t) # define PTHREAD_GETSPECIFIC_INT -# ifdef DJGPP -# define pthread_addr_t any_t -# define NEED_PTHREAD_INIT -# define PTHREAD_CREATE_JOINABLE (1) -# endif -# ifdef __OPEN_VM -# define pthread_addr_t void * -# endif # ifdef OEMVS # define pthread_addr_t void * # define pthread_create(t,a,s,d) pthread_create(t,&(a),s,d) @@ -65,7 +54,7 @@ # define pthread_mutexattr_init(a) pthread_mutexattr_create(a) # define pthread_mutexattr_settype(a,t) pthread_mutexattr_setkind_np(a,t) # endif -# if defined(DJGPP) || defined(__OPEN_VM) || defined(OEMVS) +# if defined(OEMVS) # define PTHREAD_ATTR_SETDETACHSTATE(a,s) pthread_attr_setdetachstate(a,&(s)) # define YIELD pthread_yield(NULL) # endif @@ -74,7 +63,6 @@ # define pthread_mutexattr_default NULL # define pthread_condattr_default NULL # endif -#endif /* NETWARE */ #endif #ifndef PTHREAD_CREATE @@ -94,10 +82,6 @@ # endif #endif -#ifdef DGUX -# define THREAD_CREATE_NEEDS_STACK (32*1024) -#endif - #ifdef __VMS /* Default is 1024 on VAX, 8192 otherwise */ # ifdef __ia64 @@ -115,33 +99,33 @@ #define MUTEX_INIT(m) \ STMT_START { \ - *m = mutex_alloc(); \ - if (*m) { \ - mutex_init(*m); \ - } else { \ - Perl_croak_nocontext("panic: MUTEX_INIT [%s:%d]", \ - __FILE__, __LINE__); \ - } \ + *m = mutex_alloc(); \ + if (*m) { \ + mutex_init(*m); \ + } else { \ + Perl_croak_nocontext("panic: MUTEX_INIT [%s:%d]", \ + __FILE__, __LINE__); \ + } \ } STMT_END #define MUTEX_LOCK(m) mutex_lock(*m) #define MUTEX_UNLOCK(m) mutex_unlock(*m) #define MUTEX_DESTROY(m) \ STMT_START { \ - mutex_free(*m); \ - *m = 0; \ + mutex_free(*m); \ + *m = 0; \ } STMT_END #define COND_INIT(c) \ STMT_START { \ - *c = condition_alloc(); \ - if (*c) { \ - condition_init(*c); \ - } \ - else { \ - Perl_croak_nocontext("panic: COND_INIT [%s:%d]", \ - __FILE__, __LINE__); \ - } \ + *c = condition_alloc(); \ + if (*c) { \ + condition_init(*c); \ + } \ + else { \ + Perl_croak_nocontext("panic: COND_INIT [%s:%d]", \ + __FILE__, __LINE__); \ + } \ } STMT_END #define COND_SIGNAL(c) condition_signal(*c) @@ -149,15 +133,11 @@ #define COND_WAIT(c, m) condition_wait(*c, *m) #define COND_DESTROY(c) \ STMT_START { \ - condition_free(*c); \ - *c = 0; \ + condition_free(*c); \ + *c = 0; \ } STMT_END -#define THREAD_CREATE(thr, f) (thr->self = cthread_fork(f, thr), 0) -#define THREAD_POST_CREATE(thr) - #define THREAD_RET_TYPE any_t -#define THREAD_RET_CAST(x) ((any_t) x) #define DETACH(t) cthread_detach(t->self) #define JOIN(t, avp) (*(avp) = MUTABLE_AV(cthread_join(t->self))) @@ -176,16 +156,12 @@ #ifndef YIELD # ifdef SCHED_YIELD # define YIELD SCHED_YIELD -# else -# ifdef HAS_SCHED_YIELD -# define YIELD sched_yield() -# else -# ifdef HAS_PTHREAD_YIELD +# elif defined(HAS_SCHED_YIELD) +# define YIELD sched_yield() +# elif defined(HAS_PTHREAD_YIELD) /* pthread_yield(NULL) platforms are expected * to have #defined YIELD for themselves. */ -# define YIELD pthread_yield() -# endif -# endif +# define YIELD pthread_yield() # endif #endif @@ -198,110 +174,194 @@ # ifdef MUTEX_INIT_NEEDS_MUTEX_ZEROED /* Temporary workaround, true bug is deeper. --jhi 1999-02-25 */ # define MUTEX_INIT(m) \ - STMT_START { \ - int _eC_; \ - Zero((m), 1, perl_mutex); \ - if ((_eC_ = pthread_mutex_init((m), pthread_mutexattr_default))) \ - Perl_croak_nocontext("panic: MUTEX_INIT (%d) [%s:%d]", \ - _eC_, __FILE__, __LINE__); \ + STMT_START { \ + int _eC_; \ + Zero((m), 1, perl_mutex); \ + if ((_eC_ = pthread_mutex_init((m), pthread_mutexattr_default)))\ + Perl_croak_nocontext("panic: MUTEX_INIT (%d) [%s:%d]", \ + _eC_, __FILE__, __LINE__); \ } STMT_END # else # define MUTEX_INIT(m) \ STMT_START { \ - int _eC_; \ - if ((_eC_ = pthread_mutex_init((m), pthread_mutexattr_default))) \ - Perl_croak_nocontext("panic: MUTEX_INIT (%d) [%s:%d]", \ - _eC_, __FILE__, __LINE__); \ + int _eC_; \ + if ((_eC_ = pthread_mutex_init((m), pthread_mutexattr_default))) \ + Perl_croak_nocontext("panic: MUTEX_INIT (%d) [%s:%d]", \ + _eC_, __FILE__, __LINE__); \ } STMT_END # endif -# define MUTEX_LOCK(m) \ +# ifdef PERL_TSA_ACTIVE +# define perl_pthread_mutex_lock(m) perl_tsa_mutex_lock(m) +# define perl_pthread_mutex_unlock(m) perl_tsa_mutex_unlock(m) +# else +# define perl_pthread_mutex_lock(m) pthread_mutex_lock(m) +# define perl_pthread_mutex_unlock(m) pthread_mutex_unlock(m) +# endif + +# define MUTEX_LOCK(m) \ STMT_START { \ - int _eC_; \ - if ((_eC_ = pthread_mutex_lock((m)))) \ - Perl_croak_nocontext("panic: MUTEX_LOCK (%d) [%s:%d]", \ - _eC_, __FILE__, __LINE__); \ + dSAVE_ERRNO; \ + int _eC_; \ + if ((_eC_ = perl_pthread_mutex_lock((m)))) \ + Perl_croak_nocontext("panic: MUTEX_LOCK (%d) [%s:%d]",\ + _eC_, __FILE__, __LINE__); \ + RESTORE_ERRNO; \ } STMT_END -# define MUTEX_UNLOCK(m) \ +# define MUTEX_UNLOCK(m) \ STMT_START { \ - int _eC_; \ - if ((_eC_ = pthread_mutex_unlock((m)))) \ - Perl_croak_nocontext("panic: MUTEX_UNLOCK (%d) [%s:%d]", \ - _eC_, __FILE__, __LINE__); \ + dSAVE_ERRNO; /* Shouldn't be necessary as panics if fails */\ + int _eC_; \ + if ((_eC_ = perl_pthread_mutex_unlock((m)))) { \ + Perl_croak_nocontext( \ + "panic: MUTEX_UNLOCK (%d) [%s:%d]", \ + _eC_, __FILE__, __LINE__); \ + } \ + RESTORE_ERRNO; \ } STMT_END -# define MUTEX_DESTROY(m) \ +# define MUTEX_DESTROY(m) \ STMT_START { \ - int _eC_; \ - if ((_eC_ = pthread_mutex_destroy((m)))) \ - Perl_croak_nocontext("panic: MUTEX_DESTROY (%d) [%s:%d]", \ - _eC_, __FILE__, __LINE__); \ + int _eC_; \ + if ((_eC_ = pthread_mutex_destroy((m)))) { \ + Perl_croak_nocontext("panic: MUTEX_DESTROY (%d) [%s:%d]", \ + _eC_, __FILE__, __LINE__); \ + } \ } STMT_END #endif /* MUTEX_INIT */ #ifndef COND_INIT # define COND_INIT(c) \ STMT_START { \ - int _eC_; \ - if ((_eC_ = pthread_cond_init((c), pthread_condattr_default))) \ - Perl_croak_nocontext("panic: COND_INIT (%d) [%s:%d]", \ - _eC_, __FILE__, __LINE__); \ + int _eC_; \ + if ((_eC_ = pthread_cond_init((c), pthread_condattr_default))) \ + Perl_croak_nocontext("panic: COND_INIT (%d) [%s:%d]", \ + _eC_, __FILE__, __LINE__); \ } STMT_END # define COND_SIGNAL(c) \ STMT_START { \ - int _eC_; \ - if ((_eC_ = pthread_cond_signal((c)))) \ - Perl_croak_nocontext("panic: COND_SIGNAL (%d) [%s:%d]", \ - _eC_, __FILE__, __LINE__); \ + int _eC_; \ + if ((_eC_ = pthread_cond_signal((c)))) \ + Perl_croak_nocontext("panic: COND_SIGNAL (%d) [%s:%d]", \ + _eC_, __FILE__, __LINE__); \ } STMT_END # define COND_BROADCAST(c) \ STMT_START { \ - int _eC_; \ - if ((_eC_ = pthread_cond_broadcast((c)))) \ - Perl_croak_nocontext("panic: COND_BROADCAST (%d) [%s:%d]", \ - _eC_, __FILE__, __LINE__); \ + int _eC_; \ + if ((_eC_ = pthread_cond_broadcast((c)))) \ + Perl_croak_nocontext("panic: COND_BROADCAST (%d) [%s:%d]", \ + _eC_, __FILE__, __LINE__); \ } STMT_END # define COND_WAIT(c, m) \ STMT_START { \ - int _eC_; \ - if ((_eC_ = pthread_cond_wait((c), (m)))) \ - Perl_croak_nocontext("panic: COND_WAIT (%d) [%s:%d]", \ - _eC_, __FILE__, __LINE__); \ + int _eC_; \ + if ((_eC_ = pthread_cond_wait((c), (m)))) \ + Perl_croak_nocontext("panic: COND_WAIT (%d) [%s:%d]", \ + _eC_, __FILE__, __LINE__); \ } STMT_END # define COND_DESTROY(c) \ STMT_START { \ - int _eC_; \ - if ((_eC_ = pthread_cond_destroy((c)))) \ - Perl_croak_nocontext("panic: COND_DESTROY (%d) [%s:%d]", \ - _eC_, __FILE__, __LINE__); \ + int _eC_; \ + if ((_eC_ = pthread_cond_destroy((c)))) \ + Perl_croak_nocontext("panic: COND_DESTROY (%d) [%s:%d]", \ + _eC_, __FILE__, __LINE__); \ } STMT_END #endif /* COND_INIT */ +#if defined(MUTEX_LOCK) && defined(MUTEX_UNLOCK) \ + && defined(COND_SIGNAL) && defined(COND_WAIT) + +/* These emulate native many-reader/1-writer locks. + * Basically a locking reader just locks the semaphore long enough to increment + * a counter; and similarly decrements it when when through. Any writer will + * run only when the count of readers is 0. That is because it blocks on that + * semaphore (doing a COND_WAIT) until it gets control of it, which won't + * happen unless the count becomes 0. ALL readers and other writers are then + * blocked until it releases the semaphore. The reader whose unlocking causes + * the count to become 0 signals any waiting writers, and the system guarantees + * that only one gets control at a time */ + +# define PERL_READ_LOCK(mutex) \ + STMT_START { \ + MUTEX_LOCK(&(mutex)->lock); \ + (mutex)->readers_count++; \ + MUTEX_UNLOCK(&(mutex)->lock); \ + } STMT_END + +# define PERL_READ_UNLOCK(mutex) \ + STMT_START { \ + MUTEX_LOCK(&(mutex)->lock); \ + (mutex)->readers_count--; \ + if ((mutex)->readers_count <= 0) { \ + assert((mutex)->readers_count == 0); \ + COND_SIGNAL(&(mutex)->wakeup); \ + (mutex)->readers_count = 0; \ + } \ + MUTEX_UNLOCK(&(mutex)->lock); \ + } STMT_END + +# define PERL_WRITE_LOCK(mutex) \ + STMT_START { \ + MUTEX_LOCK(&(mutex)->lock); \ + do { \ + if ((mutex)->readers_count <= 0) { \ + assert((mutex)->readers_count == 0); \ + (mutex)->readers_count = 0; \ + break; \ + } \ + COND_WAIT(&(mutex)->wakeup, &(mutex)->lock); \ + } \ + while (1); \ + \ + /* Here, the mutex is locked, with no readers */ \ + } STMT_END + +# define PERL_WRITE_UNLOCK(mutex) \ + STMT_START { \ + COND_SIGNAL(&(mutex)->wakeup); \ + MUTEX_UNLOCK(&(mutex)->lock); \ + } STMT_END + +# define PERL_RW_MUTEX_INIT(mutex) \ + STMT_START { \ + MUTEX_INIT(&(mutex)->lock); \ + COND_INIT(&(mutex)->wakeup); \ + (mutex)->readers_count = 0; \ + } STMT_END + +# define PERL_RW_MUTEX_DESTROY(mutex) \ + STMT_START { \ + COND_DESTROY(&(mutex)->wakeup); \ + MUTEX_DESTROY(&(mutex)->lock); \ + } STMT_END + +#endif + /* DETACH(t) must only be called while holding t->mutex */ #ifndef DETACH # define DETACH(t) \ STMT_START { \ - int _eC_; \ - if ((_eC_ = pthread_detach((t)->self))) { \ - MUTEX_UNLOCK(&(t)->mutex); \ - Perl_croak_nocontext("panic: DETACH (%d) [%s:%d]", \ - _eC_, __FILE__, __LINE__); \ - } \ + int _eC_; \ + if ((_eC_ = pthread_detach((t)->self))) { \ + MUTEX_UNLOCK(&(t)->mutex); \ + Perl_croak_nocontext("panic: DETACH (%d) [%s:%d]", \ + _eC_, __FILE__, __LINE__); \ + } \ } STMT_END #endif /* DETACH */ #ifndef JOIN # define JOIN(t, avp) \ STMT_START { \ - int _eC_; \ - if ((_eC_ = pthread_join((t)->self, (void**)(avp)))) \ - Perl_croak_nocontext("panic: pthread_join (%d) [%s:%d]", \ - _eC_, __FILE__, __LINE__); \ + int _eC_; \ + if ((_eC_ = pthread_join((t)->self, (void**)(avp)))) \ + Perl_croak_nocontext("panic: pthread_join (%d) [%s:%d]", \ + _eC_, __FILE__, __LINE__); \ } STMT_END #endif /* JOIN */ @@ -319,19 +379,50 @@ # define PTHREAD_GETSPECIFIC(key) pthread_getspecific(key) #endif -#ifndef PERL_GET_CONTEXT -# define PERL_GET_CONTEXT PTHREAD_GETSPECIFIC(PL_thr_key) -#endif - -#ifndef PERL_SET_CONTEXT -# define PERL_SET_CONTEXT(t) \ - STMT_START { \ - int _eC_; \ - if ((_eC_ = pthread_setspecific(PL_thr_key, (void *)(t)))) \ - Perl_croak_nocontext("panic: pthread_setspecific (%d) [%s:%d]", \ - _eC_, __FILE__, __LINE__); \ +#if defined(PERL_THREAD_LOCAL) && !defined(PERL_GET_CONTEXT) && !defined(PERL_SET_CONTEXT) && !defined(__cplusplus) +/* Use C11 thread-local storage, where possible. + * Frustratingly we can't use it for C++ extensions, C++ and C disagree on the + * syntax used for thread local storage, meaning that the working token that + * Configure probed for C turns out to be a compiler error on C++. Great. + * (Well, unless one or both is supporting non-standard syntax as an extension) + * As Configure doesn't have a way to probe for C++ dialects, we just take the + * safe option and do the same as 5.34.0 and earlier - use pthreads on C++. + * Of course, if C++ XS extensions really want to avoid *all* this overhead, + * they should #define PERL_NO_GET_CONTEXT and pass aTHX/aTHX_ explicitly) */ +# define PERL_USE_THREAD_LOCAL +extern PERL_THREAD_LOCAL void *PL_current_context; + +# define PERL_GET_CONTEXT PL_current_context + +/* We must also call pthread_setspecific() always, as C++ code has to read it + * with pthreads (the #else side just below) */ + +# define PERL_SET_CONTEXT(t) \ + STMT_START { \ + int _eC_; \ + if ((_eC_ = pthread_setspecific(PL_thr_key, \ + PL_current_context = (void *)(t)))) \ + Perl_croak_nocontext("panic: pthread_setspecific (%d) [%s:%d]", \ + _eC_, __FILE__, __LINE__); \ } STMT_END -#endif /* PERL_SET_CONTEXT */ + +#else +/* else fall back to pthreads */ + +# ifndef PERL_GET_CONTEXT +# define PERL_GET_CONTEXT PTHREAD_GETSPECIFIC(PL_thr_key) +# endif + +/* For C++ extensions built on a system where the C compiler provides thread + * local storage that call PERL_SET_CONTEXT() also need to set + * PL_current_context, so need to call into C code to do this. + * To avoid exploding code complexity, do this also on C platforms that don't + * support thread local storage. PERL_SET_CONTEXT is not called that often. */ + +# ifndef PERL_SET_CONTEXT +# define PERL_SET_CONTEXT(t) Perl_set_context((void*)t) +# endif /* PERL_SET_CONTEXT */ +#endif /* PERL_THREAD_LOCAL */ #ifndef INIT_THREADS # ifdef NEED_PTHREAD_INIT @@ -342,33 +433,32 @@ #ifndef ALLOC_THREAD_KEY # define ALLOC_THREAD_KEY \ STMT_START { \ - if (pthread_key_create(&PL_thr_key, 0)) { \ - write(2, STR_WITH_LEN("panic: pthread_key_create failed\n")); \ - exit(1); \ - } \ + if (pthread_key_create(&PL_thr_key, 0)) { \ + PERL_UNUSED_RESULT(write(2, STR_WITH_LEN("panic: pthread_key_create failed\n"))); \ + exit(1); \ + } \ } STMT_END #endif #ifndef FREE_THREAD_KEY # define FREE_THREAD_KEY \ STMT_START { \ - pthread_key_delete(PL_thr_key); \ + pthread_key_delete(PL_thr_key); \ } STMT_END #endif #ifndef PTHREAD_ATFORK # ifdef HAS_PTHREAD_ATFORK # define PTHREAD_ATFORK(prepare,parent,child) \ - pthread_atfork(prepare,parent,child) + pthread_atfork(prepare,parent,child) # else # define PTHREAD_ATFORK(prepare,parent,child) \ - NOOP + NOOP # endif #endif #ifndef THREAD_RET_TYPE # define THREAD_RET_TYPE void * -# define THREAD_RET_CAST(p) ((void *)(p)) #endif /* THREAD_RET */ # define LOCK_DOLLARZERO_MUTEX MUTEX_LOCK(&PL_dollarzero_mutex) @@ -377,87 +467,56 @@ #endif /* USE_ITHREADS */ #ifndef MUTEX_LOCK -# define MUTEX_LOCK(m) +# define MUTEX_LOCK(m) NOOP #endif #ifndef MUTEX_UNLOCK -# define MUTEX_UNLOCK(m) +# define MUTEX_UNLOCK(m) NOOP #endif #ifndef MUTEX_INIT -# define MUTEX_INIT(m) +# define MUTEX_INIT(m) NOOP #endif #ifndef MUTEX_DESTROY -# define MUTEX_DESTROY(m) +# define MUTEX_DESTROY(m) NOOP #endif #ifndef COND_INIT -# define COND_INIT(c) +# define COND_INIT(c) NOOP #endif #ifndef COND_SIGNAL -# define COND_SIGNAL(c) +# define COND_SIGNAL(c) NOOP #endif #ifndef COND_BROADCAST -# define COND_BROADCAST(c) +# define COND_BROADCAST(c) NOOP #endif #ifndef COND_WAIT -# define COND_WAIT(c, m) +# define COND_WAIT(c, m) NOOP #endif #ifndef COND_DESTROY -# define COND_DESTROY(c) -#endif - -#ifndef LOCK_SV_MUTEX -# define LOCK_SV_MUTEX -#endif - -#ifndef UNLOCK_SV_MUTEX -# define UNLOCK_SV_MUTEX -#endif - -#ifndef LOCK_STRTAB_MUTEX -# define LOCK_STRTAB_MUTEX +# define COND_DESTROY(c) NOOP #endif -#ifndef UNLOCK_STRTAB_MUTEX -# define UNLOCK_STRTAB_MUTEX -#endif - -#ifndef LOCK_CRED_MUTEX -# define LOCK_CRED_MUTEX -#endif - -#ifndef UNLOCK_CRED_MUTEX -# define UNLOCK_CRED_MUTEX -#endif - -#ifndef LOCK_FDPID_MUTEX -# define LOCK_FDPID_MUTEX -#endif - -#ifndef UNLOCK_FDPID_MUTEX -# define UNLOCK_FDPID_MUTEX -#endif - -#ifndef LOCK_SV_LOCK_MUTEX -# define LOCK_SV_LOCK_MUTEX -#endif - -#ifndef UNLOCK_SV_LOCK_MUTEX -# define UNLOCK_SV_LOCK_MUTEX +#ifndef PERL_READ_LOCK +# define PERL_READ_LOCK NOOP +# define PERL_READ_UNLOCK NOOP +# define PERL_WRITE_LOCK NOOP +# define PERL_WRITE_UNLOCK NOOP +# define PERL_RW_MUTEX_INIT NOOP +# define PERL_RW_MUTEX_DESTROY NOOP #endif #ifndef LOCK_DOLLARZERO_MUTEX -# define LOCK_DOLLARZERO_MUTEX +# define LOCK_DOLLARZERO_MUTEX NOOP #endif #ifndef UNLOCK_DOLLARZERO_MUTEX -# define UNLOCK_DOLLARZERO_MUTEX +# define UNLOCK_DOLLARZERO_MUTEX NOOP #endif /* THR, SET_THR, and dTHR are there for compatibility with old versions */ @@ -478,11 +537,5 @@ #endif /* - * Local variables: - * c-indentation-style: bsd - * c-basic-offset: 4 - * indent-tabs-mode: t - * End: - * - * ex: set ts=8 sts=4 sw=4 noet: + * ex: set ts=8 sts=4 sw=4 et: */