source: trunk/third/perl/thread.h @ 20075

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