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 
408 typedef 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
527