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

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