Socket::my_inet_aton() tweak
[p5sagit/p5-mst-13.2.git] / thread.h
CommitLineData
4d1ff10f 1#if defined(USE_5005THREADS) || defined(USE_ITHREADS)
12ca11f6 2
fd8cd3a3 3#if defined(VMS)
4#include <builtins.h>
5#endif
6
ea0efc06 7#ifdef WIN32
d55594ae 8# include <win32thread.h>
9#else
2986a63f 10#ifdef NETWARE
11# include <nw5thread.h>
12#else
0d85d877 13# ifdef OLD_PTHREADS_API /* Here be dragons. */
ba869deb 14# define DETACH(t) \
15 STMT_START { \
16 if (pthread_detach(&(t)->self)) { \
17 MUTEX_UNLOCK(&(t)->mutex); \
efc57feb 18 Perl_croak_nocontext("panic: DETACH"); \
ba869deb 19 } \
ea0efc06 20 } STMT_END
ba869deb 21
22# define PERL_GET_CONTEXT Perl_get_context()
23# define PERL_SET_CONTEXT(t) Perl_set_context((void*)t)
24
0d85d877 25# define PTHREAD_GETSPECIFIC_INT
26# ifdef DJGPP
27# define pthread_addr_t any_t
28# define NEED_PTHREAD_INIT
6dc3770d 29# define PTHREAD_CREATE_JOINABLE (1)
0d85d877 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)
6dc3770d 37# define PTHREAD_CREATE(t,a,s,d) pthread_create(t,a,s,d)
0d85d877 38# define pthread_key_create(k,d) pthread_keycreate(k,(pthread_destructor_t)(d))
39# define pthread_mutexattr_init(a) pthread_mutexattr_create(a)
9bbd4fab 40# define pthread_mutexattr_settype(a,t) pthread_mutexattr_setkind_np(a,t)
0d85d877 41# endif
2eb25c99 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 */
10617789 45# define PTHREAD_ATTR_SETDETACHSTATE(a,s) (0)
2eb25c99 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
0d85d877 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
0d85d877 55# endif
2eb25c99 56# if !defined(__hpux) || !defined(__ux_version) || __ux_version > 1020
1cfa4ec7 57# define pthread_mutexattr_default NULL
0d85d877 58# define pthread_condattr_default NULL
2eb25c99 59# endif
2986a63f 60#endif /* NETWARE */
0d85d877 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)
d55594ae 70#endif
1cfa4ec7 71
ef4af2be 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
5cbe9849 80#ifdef DGUX
81# define THREAD_CREATE_NEEDS_STACK (16*1024)
82#endif
83
7f3d1cf1 84#ifdef I_MACH_CTHREADS
85
86/* cthreads interface */
87
88/* #include <mach/cthreads.h> is in perl.h #ifdef I_MACH_CTHREADS */
89
ba869deb 90#define MUTEX_INIT(m) \
91 STMT_START { \
92 *m = mutex_alloc(); \
93 if (*m) { \
94 mutex_init(*m); \
95 } else { \
efc57feb 96 Perl_croak_nocontext("panic: MUTEX_INIT"); \
ba869deb 97 } \
98 } STMT_END
99
100#define MUTEX_LOCK(m) mutex_lock(*m)
ba869deb 101#define MUTEX_UNLOCK(m) mutex_unlock(*m)
ba869deb 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 { \
efc57feb 115 Perl_croak_nocontext("panic: COND_INIT"); \
ba869deb 116 } \
117 } STMT_END
7f3d1cf1 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)
ba869deb 122#define COND_DESTROY(c) \
123 STMT_START { \
124 condition_free(*c); \
125 *c = 0; \
126 } STMT_END
7f3d1cf1 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
ba869deb 137#define PERL_SET_CONTEXT(t) cthread_set_data(cthread_self(), t)
138#define PERL_GET_CONTEXT cthread_data(cthread_self())
7f3d1cf1 139
140#define INIT_THREADS cthread_init()
141#define YIELD cthread_yield()
ba869deb 142#define ALLOC_THREAD_KEY NOOP
e1b5da64 143#define FREE_THREAD_KEY NOOP
7f3d1cf1 144#define SET_THREAD_SELF(thr) (thr->self = cthread_self())
145
146#endif /* I_MACH_CTHREADS */
147
1cfa4ec7 148#ifndef YIELD
e7a4f449 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
9731c6ca 162#endif
11343788 163
227c31c3 164#ifdef __hpux
165# define MUTEX_INIT_NEEDS_MUTEX_ZEROED
166#endif
167
ea0efc06 168#ifndef MUTEX_INIT
ba869deb 169
170# ifdef MUTEX_INIT_NEEDS_MUTEX_ZEROED
227c31c3 171 /* Temporary workaround, true bug is deeper. --jhi 1999-02-25 */
ba869deb 172# define MUTEX_INIT(m) \
227c31c3 173 STMT_START { \
174 Zero((m), 1, perl_mutex); \
175 if (pthread_mutex_init((m), pthread_mutexattr_default)) \
efc57feb 176 Perl_croak_nocontext("panic: MUTEX_INIT"); \
227c31c3 177 } STMT_END
ba869deb 178# else
179# define MUTEX_INIT(m) \
ea0efc06 180 STMT_START { \
181 if (pthread_mutex_init((m), pthread_mutexattr_default)) \
efc57feb 182 Perl_croak_nocontext("panic: MUTEX_INIT"); \
ea0efc06 183 } STMT_END
ba869deb 184# endif
185
186# define MUTEX_LOCK(m) \
187 STMT_START { \
188 if (pthread_mutex_lock((m))) \
ba869deb 189 Perl_croak_nocontext("panic: MUTEX_LOCK"); \
cea2e8a9 190 } STMT_END
ba869deb 191
efc57feb 192# define MUTEX_UNLOCK(m) \
ba869deb 193 STMT_START { \
194 if (pthread_mutex_unlock((m))) \
195 Perl_croak_nocontext("panic: MUTEX_UNLOCK"); \
ea0efc06 196 } STMT_END
ba869deb 197
198# define MUTEX_DESTROY(m) \
199 STMT_START { \
200 if (pthread_mutex_destroy((m))) \
efc57feb 201 Perl_croak_nocontext("panic: MUTEX_DESTROY"); \
ea0efc06 202 } STMT_END
203#endif /* MUTEX_INIT */
204
205#ifndef COND_INIT
ba869deb 206# define COND_INIT(c) \
ea0efc06 207 STMT_START { \
208 if (pthread_cond_init((c), pthread_condattr_default)) \
efc57feb 209 Perl_croak_nocontext("panic: COND_INIT"); \
ea0efc06 210 } STMT_END
ba869deb 211
212# define COND_SIGNAL(c) \
213 STMT_START { \
214 if (pthread_cond_signal((c))) \
efc57feb 215 Perl_croak_nocontext("panic: COND_SIGNAL"); \
ea0efc06 216 } STMT_END
ba869deb 217
218# define COND_BROADCAST(c) \
219 STMT_START { \
220 if (pthread_cond_broadcast((c))) \
efc57feb 221 Perl_croak_nocontext("panic: COND_BROADCAST"); \
ea0efc06 222 } STMT_END
ba869deb 223
224# define COND_WAIT(c, m) \
225 STMT_START { \
226 if (pthread_cond_wait((c), (m))) \
efc57feb 227 Perl_croak_nocontext("panic: COND_WAIT"); \
ea0efc06 228 } STMT_END
ba869deb 229
230# define COND_DESTROY(c) \
231 STMT_START { \
232 if (pthread_cond_destroy((c))) \
efc57feb 233 Perl_croak_nocontext("panic: COND_DESTROY"); \
ea0efc06 234 } STMT_END
235#endif /* COND_INIT */
33f46ff6 236
f826a10b 237/* DETACH(t) must only be called while holding t->mutex */
ea0efc06 238#ifndef DETACH
ba869deb 239# define DETACH(t) \
240 STMT_START { \
241 if (pthread_detach((t)->self)) { \
242 MUTEX_UNLOCK(&(t)->mutex); \
efc57feb 243 Perl_croak_nocontext("panic: DETACH"); \
ba869deb 244 } \
ea0efc06 245 } STMT_END
246#endif /* DETACH */
33f46ff6 247
ea0efc06 248#ifndef JOIN
ba869deb 249# define JOIN(t, avp) \
250 STMT_START { \
251 if (pthread_join((t)->self, (void**)(avp))) \
efc57feb 252 Perl_croak_nocontext("panic: pthread_join"); \
ea0efc06 253 } STMT_END
254#endif /* JOIN */
255
0953243c 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 */
026b9da6 259#if (defined(__ALPHA) && (__VMS_VER >= 70000000)) || \
8b8b35ab 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)
ba869deb 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))) \
efc57feb 278 Perl_croak_nocontext("panic: pthread_setspecific"); \
ea0efc06 279 } STMT_END
ba869deb 280#endif /* PERL_SET_CONTEXT */
ea0efc06 281
1feb2720 282#ifndef INIT_THREADS
283# ifdef NEED_PTHREAD_INIT
284# define INIT_THREADS pthread_init()
285# endif
0d85d877 286#endif
ea0efc06 287
ba869deb 288#ifndef ALLOC_THREAD_KEY
289# define ALLOC_THREAD_KEY \
290 STMT_START { \
c44d3fdb 291 if (pthread_key_create(&PL_thr_key, 0)) { \
7bd161a1 292 PerlIO_printf(PerlIO_stderr(), "panic: pthread_key_create"); \
c44d3fdb 293 exit(1); \
294 } \
ba869deb 295 } STMT_END
296#endif
297
e1b5da64 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
50dd6e57 305#ifndef PTHREAD_ATFORK
144e72cb 306# ifdef HAS_PTHREAD_ATFORK
307# define PTHREAD_ATFORK(prepare,parent,child) \
de992003 308 pthread_atfork(prepare,parent,child)
144e72cb 309# else
8ff9412f 310# define PTHREAD_ATFORK(prepare,parent,child) \
311 NOOP
144e72cb 312# endif
50dd6e57 313#endif
314
1feb2720 315#ifndef THREAD_RET_TYPE
316# define THREAD_RET_TYPE void *
317# define THREAD_RET_CAST(p) ((void *)(p))
318#endif /* THREAD_RET */
319
4d1ff10f 320#if defined(USE_5005THREADS)
1feb2720 321
940cb80d 322/* Accessor for per-thread SVs */
1feb2720 323# define THREADSV(i) (thr->threadsvp[i])
940cb80d 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.
b099ddc0 330 * XXX do NOT use C<if (PL_threadnum) ...> -- it sets up race conditions!
940cb80d 331 */
1feb2720 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)
4755096e 338# define LOCK_FDPID_MUTEX MUTEX_LOCK(&PL_fdpid_mutex)
339# define UNLOCK_FDPID_MUTEX MUTEX_UNLOCK(&PL_fdpid_mutex)
631cfb58 340# define LOCK_SV_LOCK_MUTEX MUTEX_LOCK(&PL_sv_lock_mutex)
341# define UNLOCK_SV_LOCK_MUTEX MUTEX_UNLOCK(&PL_sv_lock_mutex)
11343788 342
33f46ff6 343/* Values and macros for thr->flags */
605e5515 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
f93b4edd 350
458fb581 351#define THRf_DID_DIE 8
07b73707 352
f826a10b 353/* ThrSTATE(t) and ThrSETSTATE(t) must only be called while holding t->mutex */
458fb581 354#define ThrSTATE(t) ((t)->flags & THRf_STATE_MASK)
f93b4edd 355#define ThrSETSTATE(t, s) STMT_START { \
605e5515 356 (t)->flags &= ~THRf_STATE_MASK; \
33f46ff6 357 (t)->flags |= (s); \
bf49b057 358 DEBUG_S(PerlIO_printf(Perl_debug_log, \
605e5515 359 "thread %p set to state %d\n", (t), (s))); \
f93b4edd 360 } STMT_END
361
362typedef struct condpair {
f826a10b 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 */
f93b4edd 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
4d1ff10f 374#endif /* USE_5005THREADS */
375#endif /* USE_5005THREADS || USE_ITHREADS */
1feb2720 376
377#ifndef MUTEX_LOCK
378# define MUTEX_LOCK(m)
379#endif
380
1feb2720 381#ifndef MUTEX_UNLOCK
382# define MUTEX_UNLOCK(m)
383#endif
1feb2720 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
4755096e 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
631cfb58 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
ba869deb 453/* THR, SET_THR, and dTHR are there for compatibility with old versions */
1feb2720 454#ifndef THR
ba869deb 455# define THR PERL_GET_THX
456#endif
457
458#ifndef SET_THR
459# define SET_THR(t) PERL_SET_THX(t)
1feb2720 460#endif
461
462#ifndef dTHR
463# define dTHR dNOOP
464#endif
465
466#ifndef INIT_THREADS
467# define INIT_THREADS NOOP
468#endif