This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
SYN SYN
[perl5.git] / thread.h
CommitLineData
1feb2720 1#if defined(USE_THREADS) || defined(USE_ITHREADS)
12ca11f6 2
ea0efc06 3#ifdef WIN32
d55594ae
GS
4# include <win32thread.h>
5#else
0d85d877 6# ifdef OLD_PTHREADS_API /* Here be dragons. */
ba869deb
GS
7# define DETACH(t) \
8 STMT_START { \
9 if (pthread_detach(&(t)->self)) { \
10 MUTEX_UNLOCK(&(t)->mutex); \
efc57feb 11 Perl_croak_nocontext("panic: DETACH"); \
ba869deb 12 } \
ea0efc06 13 } STMT_END
ba869deb
GS
14
15# define PERL_GET_CONTEXT Perl_get_context()
16# define PERL_SET_CONTEXT(t) Perl_set_context((void*)t)
17
0d85d877
JH
18# define PTHREAD_GETSPECIFIC_INT
19# ifdef DJGPP
20# define pthread_addr_t any_t
21# define NEED_PTHREAD_INIT
6dc3770d 22# define PTHREAD_CREATE_JOINABLE (1)
0d85d877
JH
23# endif
24# ifdef __OPEN_VM
25# define pthread_addr_t void *
26# endif
27# ifdef VMS
28# define pthread_attr_init(a) pthread_attr_create(a)
29# define PTHREAD_ATTR_SETDETACHSTATE(a,s) pthread_setdetach_np(a,s)
6dc3770d 30# define PTHREAD_CREATE(t,a,s,d) pthread_create(t,a,s,d)
0d85d877
JH
31# define pthread_key_create(k,d) pthread_keycreate(k,(pthread_destructor_t)(d))
32# define pthread_mutexattr_init(a) pthread_mutexattr_create(a)
9bbd4fab 33# define pthread_mutexattr_settype(a,t) pthread_mutexattr_setkind_np(a,t)
0d85d877 34# endif
b82d478d
CB
35# if defined(__hpux) && defined(__ux_version) && __ux_version <= 1020
36# define pthread_attr_init(a) pthread_attr_create(a)
37 /* XXX pthread_setdetach_np() missing in DCE threads on HP-UX 10.20 */
38# define PTHREAD_CREATE(t,a,s,d) pthread_create(t,a,s,d)
39# define pthread_key_create(k,d) pthread_keycreate(k,(pthread_destructor_t)(d))
40# define pthread_mutexattr_init(a) pthread_mutexattr_create(a)
41# define pthread_mutexattr_settype(a,t) pthread_mutexattr_setkind_np(a,t)
42# endif
0d85d877
JH
43# if defined(DJGPP) || defined(__OPEN_VM)
44# define PTHREAD_ATTR_SETDETACHSTATE(a,s) pthread_attr_setdetachstate(a,&(s))
45# define YIELD pthread_yield(NULL)
46# endif
0d85d877 47# endif
b82d478d 48# if !defined(__hpux) || !defined(__ux_version) || __ux_version > 1020
1cfa4ec7 49# define pthread_mutexattr_default NULL
0d85d877 50# define pthread_condattr_default NULL
b82d478d 51# endif
0d85d877
JH
52#endif
53
54#ifndef PTHREAD_CREATE
55/* You are not supposed to pass NULL as the 2nd arg of PTHREAD_CREATE(). */
56# define PTHREAD_CREATE(t,a,s,d) pthread_create(t,&(a),s,d)
57#endif
58
59#ifndef PTHREAD_ATTR_SETDETACHSTATE
60# define PTHREAD_ATTR_SETDETACHSTATE(a,s) pthread_attr_setdetachstate(a,s)
d55594ae 61#endif
1cfa4ec7 62
ef4af2be
JH
63#ifndef PTHREAD_CREATE_JOINABLE
64# ifdef OLD_PTHREAD_CREATE_JOINABLE
65# define PTHREAD_CREATE_JOINABLE OLD_PTHREAD_CREATE_JOINABLE
66# else
67# define PTHREAD_CREATE_JOINABLE 0 /* Panic? No, guess. */
68# endif
69#endif
70
7f3d1cf1
BH
71#ifdef I_MACH_CTHREADS
72
73/* cthreads interface */
74
75/* #include <mach/cthreads.h> is in perl.h #ifdef I_MACH_CTHREADS */
76
ba869deb
GS
77#define MUTEX_INIT(m) \
78 STMT_START { \
79 *m = mutex_alloc(); \
80 if (*m) { \
81 mutex_init(*m); \
82 } else { \
efc57feb 83 Perl_croak_nocontext("panic: MUTEX_INIT"); \
ba869deb
GS
84 } \
85 } STMT_END
86
87#define MUTEX_LOCK(m) mutex_lock(*m)
ba869deb 88#define MUTEX_UNLOCK(m) mutex_unlock(*m)
ba869deb
GS
89#define MUTEX_DESTROY(m) \
90 STMT_START { \
91 mutex_free(*m); \
92 *m = 0; \
93 } STMT_END
94
95#define COND_INIT(c) \
96 STMT_START { \
97 *c = condition_alloc(); \
98 if (*c) { \
99 condition_init(*c); \
100 } \
101 else { \
efc57feb 102 Perl_croak_nocontext("panic: COND_INIT"); \
ba869deb
GS
103 } \
104 } STMT_END
7f3d1cf1
BH
105
106#define COND_SIGNAL(c) condition_signal(*c)
107#define COND_BROADCAST(c) condition_broadcast(*c)
108#define COND_WAIT(c, m) condition_wait(*c, *m)
ba869deb
GS
109#define COND_DESTROY(c) \
110 STMT_START { \
111 condition_free(*c); \
112 *c = 0; \
113 } STMT_END
7f3d1cf1
BH
114
115#define THREAD_CREATE(thr, f) (thr->self = cthread_fork(f, thr), 0)
116#define THREAD_POST_CREATE(thr)
117
118#define THREAD_RET_TYPE any_t
119#define THREAD_RET_CAST(x) ((any_t) x)
120
121#define DETACH(t) cthread_detach(t->self)
122#define JOIN(t, avp) (*(avp) = (AV *)cthread_join(t->self))
123
ba869deb
GS
124#define PERL_SET_CONTEXT(t) cthread_set_data(cthread_self(), t)
125#define PERL_GET_CONTEXT cthread_data(cthread_self())
7f3d1cf1
BH
126
127#define INIT_THREADS cthread_init()
128#define YIELD cthread_yield()
ba869deb 129#define ALLOC_THREAD_KEY NOOP
22d4bb9c 130#define FREE_THREAD_KEY NOOP
7f3d1cf1
BH
131#define SET_THREAD_SELF(thr) (thr->self = cthread_self())
132
133#endif /* I_MACH_CTHREADS */
134
1cfa4ec7 135#ifndef YIELD
e7a4f449
JH
136# ifdef SCHED_YIELD
137# define YIELD SCHED_YIELD
138# else
139# ifdef HAS_SCHED_YIELD
140# define YIELD sched_yield()
141# else
142# ifdef HAS_PTHREAD_YIELD
143 /* pthread_yield(NULL) platforms are expected
144 * to have #defined YIELD for themselves. */
145# define YIELD pthread_yield()
146# endif
147# endif
148# endif
9731c6ca 149#endif
11343788 150
227c31c3
JH
151#ifdef __hpux
152# define MUTEX_INIT_NEEDS_MUTEX_ZEROED
153#endif
154
ea0efc06 155#ifndef MUTEX_INIT
ba869deb
GS
156
157# ifdef MUTEX_INIT_NEEDS_MUTEX_ZEROED
227c31c3 158 /* Temporary workaround, true bug is deeper. --jhi 1999-02-25 */
ba869deb 159# define MUTEX_INIT(m) \
227c31c3
JH
160 STMT_START { \
161 Zero((m), 1, perl_mutex); \
162 if (pthread_mutex_init((m), pthread_mutexattr_default)) \
efc57feb 163 Perl_croak_nocontext("panic: MUTEX_INIT"); \
227c31c3 164 } STMT_END
ba869deb
GS
165# else
166# define MUTEX_INIT(m) \
ea0efc06
MB
167 STMT_START { \
168 if (pthread_mutex_init((m), pthread_mutexattr_default)) \
efc57feb 169 Perl_croak_nocontext("panic: MUTEX_INIT"); \
ea0efc06 170 } STMT_END
ba869deb
GS
171# endif
172
173# define MUTEX_LOCK(m) \
174 STMT_START { \
175 if (pthread_mutex_lock((m))) \
ba869deb 176 Perl_croak_nocontext("panic: MUTEX_LOCK"); \
cea2e8a9 177 } STMT_END
ba869deb 178
efc57feb 179# define MUTEX_UNLOCK(m) \
ba869deb
GS
180 STMT_START { \
181 if (pthread_mutex_unlock((m))) \
182 Perl_croak_nocontext("panic: MUTEX_UNLOCK"); \
ea0efc06 183 } STMT_END
ba869deb
GS
184
185# define MUTEX_DESTROY(m) \
186 STMT_START { \
187 if (pthread_mutex_destroy((m))) \
efc57feb 188 Perl_croak_nocontext("panic: MUTEX_DESTROY"); \
ea0efc06
MB
189 } STMT_END
190#endif /* MUTEX_INIT */
191
192#ifndef COND_INIT
ba869deb 193# define COND_INIT(c) \
ea0efc06
MB
194 STMT_START { \
195 if (pthread_cond_init((c), pthread_condattr_default)) \
efc57feb 196 Perl_croak_nocontext("panic: COND_INIT"); \
ea0efc06 197 } STMT_END
ba869deb
GS
198
199# define COND_SIGNAL(c) \
200 STMT_START { \
201 if (pthread_cond_signal((c))) \
efc57feb 202 Perl_croak_nocontext("panic: COND_SIGNAL"); \
ea0efc06 203 } STMT_END
ba869deb
GS
204
205# define COND_BROADCAST(c) \
206 STMT_START { \
207 if (pthread_cond_broadcast((c))) \
efc57feb 208 Perl_croak_nocontext("panic: COND_BROADCAST"); \
ea0efc06 209 } STMT_END
ba869deb
GS
210
211# define COND_WAIT(c, m) \
212 STMT_START { \
213 if (pthread_cond_wait((c), (m))) \
efc57feb 214 Perl_croak_nocontext("panic: COND_WAIT"); \
ea0efc06 215 } STMT_END
ba869deb
GS
216
217# define COND_DESTROY(c) \
218 STMT_START { \
219 if (pthread_cond_destroy((c))) \
efc57feb 220 Perl_croak_nocontext("panic: COND_DESTROY"); \
ea0efc06
MB
221 } STMT_END
222#endif /* COND_INIT */
33f46ff6 223
f826a10b 224/* DETACH(t) must only be called while holding t->mutex */
ea0efc06 225#ifndef DETACH
ba869deb
GS
226# define DETACH(t) \
227 STMT_START { \
228 if (pthread_detach((t)->self)) { \
229 MUTEX_UNLOCK(&(t)->mutex); \
efc57feb 230 Perl_croak_nocontext("panic: DETACH"); \
ba869deb 231 } \
ea0efc06
MB
232 } STMT_END
233#endif /* DETACH */
33f46ff6 234
ea0efc06 235#ifndef JOIN
ba869deb
GS
236# define JOIN(t, avp) \
237 STMT_START { \
238 if (pthread_join((t)->self, (void**)(avp))) \
efc57feb 239 Perl_croak_nocontext("panic: pthread_join"); \
ea0efc06
MB
240 } STMT_END
241#endif /* JOIN */
242
ba869deb
GS
243#ifndef PERL_GET_CONTEXT
244# define PERL_GET_CONTEXT pthread_getspecific(PL_thr_key)
245#endif
246
247#ifndef PERL_SET_CONTEXT
248# define PERL_SET_CONTEXT(t) \
249 STMT_START { \
250 if (pthread_setspecific(PL_thr_key, (void *)(t))) \
efc57feb 251 Perl_croak_nocontext("panic: pthread_setspecific"); \
ea0efc06 252 } STMT_END
ba869deb 253#endif /* PERL_SET_CONTEXT */
ea0efc06 254
1feb2720
GS
255#ifndef INIT_THREADS
256# ifdef NEED_PTHREAD_INIT
257# define INIT_THREADS pthread_init()
258# endif
0d85d877 259#endif
ea0efc06 260
ba869deb
GS
261#ifndef ALLOC_THREAD_KEY
262# define ALLOC_THREAD_KEY \
263 STMT_START { \
c44d3fdb 264 if (pthread_key_create(&PL_thr_key, 0)) { \
22d4bb9c 265 PerlIO_printf(PerlIO_stderr(), "panic: pthread_key_create"); \
c44d3fdb
GS
266 exit(1); \
267 } \
ba869deb
GS
268 } STMT_END
269#endif
270
22d4bb9c
CB
271#ifndef FREE_THREAD_KEY
272# define FREE_THREAD_KEY \
273 STMT_START { \
274 pthread_key_delete(PL_thr_key); \
275 } STMT_END
276#endif
277
1feb2720
GS
278#ifndef THREAD_RET_TYPE
279# define THREAD_RET_TYPE void *
280# define THREAD_RET_CAST(p) ((void *)(p))
281#endif /* THREAD_RET */
282
283#if defined(USE_THREADS)
284
940cb80d 285/* Accessor for per-thread SVs */
1feb2720 286# define THREADSV(i) (thr->threadsvp[i])
940cb80d
MB
287
288/*
289 * LOCK_SV_MUTEX and UNLOCK_SV_MUTEX are performance-critical. Here, we
290 * try only locking them if there may be more than one thread in existence.
291 * Systems with very fast mutexes (and/or slow conditionals) may wish to
292 * remove the "if (threadnum) ..." test.
b099ddc0 293 * XXX do NOT use C<if (PL_threadnum) ...> -- it sets up race conditions!
940cb80d 294 */
1feb2720
GS
295# define LOCK_SV_MUTEX MUTEX_LOCK(&PL_sv_mutex)
296# define UNLOCK_SV_MUTEX MUTEX_UNLOCK(&PL_sv_mutex)
297# define LOCK_STRTAB_MUTEX MUTEX_LOCK(&PL_strtab_mutex)
298# define UNLOCK_STRTAB_MUTEX MUTEX_UNLOCK(&PL_strtab_mutex)
299# define LOCK_CRED_MUTEX MUTEX_LOCK(&PL_cred_mutex)
300# define UNLOCK_CRED_MUTEX MUTEX_UNLOCK(&PL_cred_mutex)
4b19af01
CB
301# define LOCK_FDPID_MUTEX MUTEX_LOCK(&PL_fdpid_mutex)
302# define UNLOCK_FDPID_MUTEX MUTEX_UNLOCK(&PL_fdpid_mutex)
303# define LOCK_SV_LOCK_MUTEX MUTEX_LOCK(&PL_sv_lock_mutex)
304# define UNLOCK_SV_LOCK_MUTEX MUTEX_UNLOCK(&PL_sv_lock_mutex)
11343788 305
33f46ff6 306/* Values and macros for thr->flags */
605e5515
MB
307#define THRf_STATE_MASK 7
308#define THRf_R_JOINABLE 0
309#define THRf_R_JOINED 1
310#define THRf_R_DETACHED 2
311#define THRf_ZOMBIE 3
312#define THRf_DEAD 4
f93b4edd 313
458fb581 314#define THRf_DID_DIE 8
07b73707 315
f826a10b 316/* ThrSTATE(t) and ThrSETSTATE(t) must only be called while holding t->mutex */
458fb581 317#define ThrSTATE(t) ((t)->flags & THRf_STATE_MASK)
f93b4edd 318#define ThrSETSTATE(t, s) STMT_START { \
605e5515 319 (t)->flags &= ~THRf_STATE_MASK; \
33f46ff6 320 (t)->flags |= (s); \
bf49b057 321 DEBUG_S(PerlIO_printf(Perl_debug_log, \
605e5515 322 "thread %p set to state %d\n", (t), (s))); \
f93b4edd
MB
323 } STMT_END
324
325typedef struct condpair {
f826a10b
MB
326 perl_mutex mutex; /* Protects all other fields */
327 perl_cond owner_cond; /* For when owner changes at all */
328 perl_cond cond; /* For cond_signal and cond_broadcast */
329 Thread owner; /* Currently owning thread */
f93b4edd
MB
330} condpair_t;
331
332#define MgMUTEXP(mg) (&((condpair_t *)(mg->mg_ptr))->mutex)
333#define MgOWNERCONDP(mg) (&((condpair_t *)(mg->mg_ptr))->owner_cond)
334#define MgCONDP(mg) (&((condpair_t *)(mg->mg_ptr))->cond)
335#define MgOWNER(mg) ((condpair_t *)(mg->mg_ptr))->owner
336
11343788 337#endif /* USE_THREADS */
1feb2720
GS
338#endif /* USE_THREADS || USE_ITHREADS */
339
340#ifndef MUTEX_LOCK
341# define MUTEX_LOCK(m)
342#endif
343
1feb2720
GS
344#ifndef MUTEX_UNLOCK
345# define MUTEX_UNLOCK(m)
346#endif
1feb2720
GS
347
348#ifndef MUTEX_INIT
349# define MUTEX_INIT(m)
350#endif
351
352#ifndef MUTEX_DESTROY
353# define MUTEX_DESTROY(m)
354#endif
355
356#ifndef COND_INIT
357# define COND_INIT(c)
358#endif
359
360#ifndef COND_SIGNAL
361# define COND_SIGNAL(c)
362#endif
363
364#ifndef COND_BROADCAST
365# define COND_BROADCAST(c)
366#endif
367
368#ifndef COND_WAIT
369# define COND_WAIT(c, m)
370#endif
371
372#ifndef COND_DESTROY
373# define COND_DESTROY(c)
374#endif
375
376#ifndef LOCK_SV_MUTEX
377# define LOCK_SV_MUTEX
378#endif
379
380#ifndef UNLOCK_SV_MUTEX
381# define UNLOCK_SV_MUTEX
382#endif
383
384#ifndef LOCK_STRTAB_MUTEX
385# define LOCK_STRTAB_MUTEX
386#endif
387
388#ifndef UNLOCK_STRTAB_MUTEX
389# define UNLOCK_STRTAB_MUTEX
390#endif
391
392#ifndef LOCK_CRED_MUTEX
393# define LOCK_CRED_MUTEX
394#endif
395
396#ifndef UNLOCK_CRED_MUTEX
397# define UNLOCK_CRED_MUTEX
398#endif
399
4b19af01
CB
400#ifndef LOCK_FDPID_MUTEX
401# define LOCK_FDPID_MUTEX
402#endif
403
404#ifndef UNLOCK_FDPID_MUTEX
405# define UNLOCK_FDPID_MUTEX
406#endif
407
408#ifndef LOCK_SV_LOCK_MUTEX
409# define LOCK_SV_LOCK_MUTEX
410#endif
411
412#ifndef UNLOCK_SV_LOCK_MUTEX
413# define UNLOCK_SV_LOCK_MUTEX
414#endif
415
ba869deb 416/* THR, SET_THR, and dTHR are there for compatibility with old versions */
1feb2720 417#ifndef THR
ba869deb
GS
418# define THR PERL_GET_THX
419#endif
420
421#ifndef SET_THR
422# define SET_THR(t) PERL_SET_THX(t)
1feb2720
GS
423#endif
424
425#ifndef dTHR
426# define dTHR dNOOP
427#endif
428
429#ifndef INIT_THREADS
430# define INIT_THREADS NOOP
431#endif