source: for-distributions/trunk/bin/windows/perl/lib/CORE/thread.h@ 14489

Last change on this file since 14489 was 14489, checked in by oranfry, 17 years ago

upgrading to perl 5.8

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