4 # include <win32thread.h>
6 # ifdef OLD_PTHREADS_API /* Here be dragons. */
9 if (pthread_detach(&(t)->self)) { \
10 MUTEX_UNLOCK(&(t)->mutex); \
11 croak("panic: DETACH"); \
15 struct perl_thread *getTHR _((void));
16 # define PTHREAD_GETSPECIFIC_INT
18 # define pthread_addr_t any_t
19 # define NEED_PTHREAD_INIT
20 # define PTHREAD_CREATE_JOINABLE (&err)
23 # define pthread_addr_t void *
26 # define pthread_attr_init(a) pthread_attr_create(a)
27 # define PTHREAD_ATTR_SETDETACHSTATE(a,s) pthread_setdetach_np(a,s)
28 # define pthread_key_create(k,d) pthread_keycreate(k,(pthread_destructor_t)(d))
29 # define pthread_mutexattr_init(a) pthread_mutexattr_create(a)
31 # if defined(DJGPP) || defined(__OPEN_VM)
32 # define PTHREAD_ATTR_SETDETACHSTATE(a,s) pthread_attr_setdetachstate(a,&(s))
33 # define YIELD pthread_yield(NULL)
35 # if defined(DJGPP) || defined(VMS)
36 # define PTHREAD_CREATE(t,a,s,d) pthread_create(t,a,s,d)
38 # if defined(__OPEN_VM) || defined(VMS)
39 # define pthread_mutexattr_settype(a,t) pthread_mutexattr_setkind_np(a,t)
43 # define pthread_mutexattr_default NULL
44 # define pthread_condattr_default NULL
48 #ifndef PTHREAD_CREATE
49 /* You are not supposed to pass NULL as the 2nd arg of PTHREAD_CREATE(). */
50 # define PTHREAD_CREATE(t,a,s,d) pthread_create(t,&(a),s,d)
53 #ifndef PTHREAD_ATTR_SETDETACHSTATE
54 # define PTHREAD_ATTR_SETDETACHSTATE(a,s) pthread_attr_setdetachstate(a,s)
59 # define YIELD SCHED_YIELD
61 # ifdef HAS_SCHED_YIELD
62 # define YIELD sched_yield()
64 # ifdef HAS_PTHREAD_YIELD
65 /* pthread_yield(NULL) platforms are expected
66 * to have #defined YIELD for themselves. */
67 # define YIELD pthread_yield()
73 #ifdef PTHREADS_CREATED_JOINABLE
74 # define ATTR_JOINABLE PTHREAD_CREATE_JOINABLE
76 # ifdef PTHREAD_CREATE_UNDETACHED
77 # define ATTR_JOINABLE PTHREAD_CREATE_UNDETACHED
80 # define ATTR_JOINABLE __UNDETACHED
86 #define MUTEX_INIT(m) \
88 if (pthread_mutex_init((m), pthread_mutexattr_default)) \
89 croak("panic: MUTEX_INIT"); \
91 #define MUTEX_LOCK(m) \
93 if (pthread_mutex_lock((m))) \
94 croak("panic: MUTEX_LOCK"); \
96 #define MUTEX_UNLOCK(m) \
98 if (pthread_mutex_unlock((m))) \
99 croak("panic: MUTEX_UNLOCK"); \
101 #define MUTEX_DESTROY(m) \
103 if (pthread_mutex_destroy((m))) \
104 croak("panic: MUTEX_DESTROY"); \
106 #endif /* MUTEX_INIT */
109 #define COND_INIT(c) \
111 if (pthread_cond_init((c), pthread_condattr_default)) \
112 croak("panic: COND_INIT"); \
114 #define COND_SIGNAL(c) \
116 if (pthread_cond_signal((c))) \
117 croak("panic: COND_SIGNAL"); \
119 #define COND_BROADCAST(c) \
121 if (pthread_cond_broadcast((c))) \
122 croak("panic: COND_BROADCAST"); \
124 #define COND_WAIT(c, m) \
126 if (pthread_cond_wait((c), (m))) \
127 croak("panic: COND_WAIT"); \
129 #define COND_DESTROY(c) \
131 if (pthread_cond_destroy((c))) \
132 croak("panic: COND_DESTROY"); \
134 #endif /* COND_INIT */
136 /* DETACH(t) must only be called while holding t->mutex */
140 if (pthread_detach((t)->self)) { \
141 MUTEX_UNLOCK(&(t)->mutex); \
142 croak("panic: DETACH"); \
148 #define JOIN(t, avp) \
150 if (pthread_join((t)->self, (void**)(avp))) \
151 croak("panic: pthread_join"); \
158 if (pthread_setspecific(PL_thr_key, (void *) (t))) \
159 croak("panic: pthread_setspecific"); \
164 #define THR ((struct perl_thread *) pthread_getspecific(PL_thr_key))
168 * dTHR is performance-critical. Here, we only do the pthread_get_specific
169 * if there may be more than one thread in existence, otherwise we get thr
170 * from thrsv which is cached in the per-interpreter structure.
171 * Systems with very fast pthread_get_specific (which should be all systems
172 * but unfortunately isn't) may wish to simplify to "...*thr = THR".
176 struct perl_thread *thr = PL_threadnum? THR : (struct perl_thread*)SvPVX(PL_thrsv)
180 # ifdef NEED_PTHREAD_INIT
181 # define INIT_THREADS pthread_init()
183 # define INIT_THREADS NOOP
187 /* Accessor for per-thread SVs */
188 #define THREADSV(i) (thr->threadsvp[i])
191 * LOCK_SV_MUTEX and UNLOCK_SV_MUTEX are performance-critical. Here, we
192 * try only locking them if there may be more than one thread in existence.
193 * Systems with very fast mutexes (and/or slow conditionals) may wish to
194 * remove the "if (threadnum) ..." test.
196 #define LOCK_SV_MUTEX \
199 MUTEX_LOCK(&PL_sv_mutex); \
202 #define UNLOCK_SV_MUTEX \
205 MUTEX_UNLOCK(&PL_sv_mutex); \
208 /* Likewise for strtab_mutex */
209 #define LOCK_STRTAB_MUTEX \
212 MUTEX_LOCK(&PL_strtab_mutex); \
215 #define UNLOCK_STRTAB_MUTEX \
218 MUTEX_UNLOCK(&PL_strtab_mutex); \
221 #ifndef THREAD_RET_TYPE
222 # define THREAD_RET_TYPE void *
223 # define THREAD_RET_CAST(p) ((void *)(p))
224 #endif /* THREAD_RET */
227 /* Values and macros for thr->flags */
228 #define THRf_STATE_MASK 7
229 #define THRf_R_JOINABLE 0
230 #define THRf_R_JOINED 1
231 #define THRf_R_DETACHED 2
232 #define THRf_ZOMBIE 3
235 #define THRf_DID_DIE 8
237 /* ThrSTATE(t) and ThrSETSTATE(t) must only be called while holding t->mutex */
238 #define ThrSTATE(t) ((t)->flags & THRf_STATE_MASK)
239 #define ThrSETSTATE(t, s) STMT_START { \
240 (t)->flags &= ~THRf_STATE_MASK; \
242 DEBUG_S(PerlIO_printf(PerlIO_stderr(), \
243 "thread %p set to state %d\n", (t), (s))); \
246 typedef struct condpair {
247 perl_mutex mutex; /* Protects all other fields */
248 perl_cond owner_cond; /* For when owner changes at all */
249 perl_cond cond; /* For cond_signal and cond_broadcast */
250 Thread owner; /* Currently owning thread */
253 #define MgMUTEXP(mg) (&((condpair_t *)(mg->mg_ptr))->mutex)
254 #define MgOWNERCONDP(mg) (&((condpair_t *)(mg->mg_ptr))->owner_cond)
255 #define MgCONDP(mg) (&((condpair_t *)(mg->mg_ptr))->cond)
256 #define MgOWNER(mg) ((condpair_t *)(mg->mg_ptr))->owner
259 /* USE_THREADS is not defined */
260 #define MUTEX_LOCK(m)
261 #define MUTEX_UNLOCK(m)
262 #define MUTEX_INIT(m)
263 #define MUTEX_DESTROY(m)
265 #define COND_SIGNAL(c)
266 #define COND_BROADCAST(c)
267 #define COND_WAIT(c, m)
268 #define COND_DESTROY(c)
269 #define LOCK_SV_MUTEX
270 #define UNLOCK_SV_MUTEX
271 #define LOCK_STRTAB_MUTEX
272 #define UNLOCK_STRTAB_MUTEX
275 /* Rats: if dTHR is just blank then the subsequent ";" throws an error */
277 #define dTHR extern int Perl___notused
279 #define dTHR extern int errno
281 #endif /* USE_THREADS */