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