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

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