1 /* thread.h 2 * 3 * Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 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_ITHREADS) 12 13 #if defined(VMS) 14 #include <builtins.h> 15 #endif 16 17 #ifdef WIN32 18 # include <win32thread.h> 19 #else 20 # ifdef OLD_PTHREADS_API /* Here be dragons. */ 21 # define DETACH(t) \ 22 STMT_START { \ 23 int _eC_; \ 24 if ((_eC_ = pthread_detach(&(t)->self))) { \ 25 MUTEX_UNLOCK(&(t)->mutex); \ 26 Perl_croak_nocontext("panic: DETACH (%d) [%s:%d]", \ 27 _eC_, __FILE__, __LINE__); \ 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 OEMVS 36 # define pthread_addr_t void * 37 # define pthread_create(t,a,s,d) pthread_create(t,&(a),s,d) 38 # define pthread_keycreate pthread_key_create 39 # endif 40 # ifdef VMS 41 # define pthread_attr_init(a) pthread_attr_create(a) 42 # define PTHREAD_ATTR_SETDETACHSTATE(a,s) pthread_setdetach_np(a,s) 43 # define PTHREAD_CREATE(t,a,s,d) pthread_create(t,a,s,d) 44 # define pthread_key_create(k,d) pthread_keycreate(k,(pthread_destructor_t)(d)) 45 # define pthread_mutexattr_init(a) pthread_mutexattr_create(a) 46 # define pthread_mutexattr_settype(a,t) pthread_mutexattr_setkind_np(a,t) 47 # endif 48 # if defined(__hpux) && defined(__ux_version) && __ux_version <= 1020 49 # define pthread_attr_init(a) pthread_attr_create(a) 50 /* XXX pthread_setdetach_np() missing in DCE threads on HP-UX 10.20 */ 51 # define PTHREAD_ATTR_SETDETACHSTATE(a,s) (0) 52 # define PTHREAD_CREATE(t,a,s,d) pthread_create(t,a,s,d) 53 # define pthread_key_create(k,d) pthread_keycreate(k,(pthread_destructor_t)(d)) 54 # define pthread_mutexattr_init(a) pthread_mutexattr_create(a) 55 # define pthread_mutexattr_settype(a,t) pthread_mutexattr_setkind_np(a,t) 56 # endif 57 # if defined(OEMVS) 58 # define PTHREAD_ATTR_SETDETACHSTATE(a,s) pthread_attr_setdetachstate(a,&(s)) 59 # define YIELD pthread_yield(NULL) 60 # endif 61 # endif 62 # if !defined(__hpux) || !defined(__ux_version) || __ux_version > 1020 63 # define pthread_mutexattr_default NULL 64 # define pthread_condattr_default NULL 65 # endif 66 #endif 67 68 #ifndef PTHREAD_CREATE 69 /* You are not supposed to pass NULL as the 2nd arg of PTHREAD_CREATE(). */ 70 # define PTHREAD_CREATE(t,a,s,d) pthread_create(t,&(a),s,d) 71 #endif 72 73 #ifndef PTHREAD_ATTR_SETDETACHSTATE 74 # define PTHREAD_ATTR_SETDETACHSTATE(a,s) pthread_attr_setdetachstate(a,s) 75 #endif 76 77 #ifndef PTHREAD_CREATE_JOINABLE 78 # ifdef OLD_PTHREAD_CREATE_JOINABLE 79 # define PTHREAD_CREATE_JOINABLE OLD_PTHREAD_CREATE_JOINABLE 80 # else 81 # define PTHREAD_CREATE_JOINABLE 0 /* Panic? No, guess. */ 82 # endif 83 #endif 84 85 #ifdef __VMS 86 /* Default is 1024 on VAX, 8192 otherwise */ 87 # ifdef __ia64 88 # define THREAD_CREATE_NEEDS_STACK (48*1024) 89 # else 90 # define THREAD_CREATE_NEEDS_STACK (32*1024) 91 # endif 92 #endif 93 94 #ifdef I_MACH_CTHREADS 95 96 /* cthreads interface */ 97 98 /* #include <mach/cthreads.h> is in perl.h #ifdef I_MACH_CTHREADS */ 99 100 #define MUTEX_INIT(m) \ 101 STMT_START { \ 102 *m = mutex_alloc(); \ 103 if (*m) { \ 104 mutex_init(*m); \ 105 } else { \ 106 Perl_croak_nocontext("panic: MUTEX_INIT [%s:%d]", \ 107 __FILE__, __LINE__); \ 108 } \ 109 } STMT_END 110 111 #define MUTEX_LOCK(m) mutex_lock(*m) 112 #define MUTEX_UNLOCK(m) mutex_unlock(*m) 113 #define MUTEX_DESTROY(m) \ 114 STMT_START { \ 115 mutex_free(*m); \ 116 *m = 0; \ 117 } STMT_END 118 119 #define COND_INIT(c) \ 120 STMT_START { \ 121 *c = condition_alloc(); \ 122 if (*c) { \ 123 condition_init(*c); \ 124 } \ 125 else { \ 126 Perl_croak_nocontext("panic: COND_INIT [%s:%d]", \ 127 __FILE__, __LINE__); \ 128 } \ 129 } STMT_END 130 131 #define COND_SIGNAL(c) condition_signal(*c) 132 #define COND_BROADCAST(c) condition_broadcast(*c) 133 #define COND_WAIT(c, m) condition_wait(*c, *m) 134 #define COND_DESTROY(c) \ 135 STMT_START { \ 136 condition_free(*c); \ 137 *c = 0; \ 138 } STMT_END 139 140 #define THREAD_RET_TYPE any_t 141 142 #define DETACH(t) cthread_detach(t->self) 143 #define JOIN(t, avp) (*(avp) = MUTABLE_AV(cthread_join(t->self))) 144 145 #define PERL_SET_CONTEXT(t) cthread_set_data(cthread_self(), t) 146 #define PERL_GET_CONTEXT cthread_data(cthread_self()) 147 148 #define INIT_THREADS cthread_init() 149 #define YIELD cthread_yield() 150 #define ALLOC_THREAD_KEY NOOP 151 #define FREE_THREAD_KEY NOOP 152 #define SET_THREAD_SELF(thr) (thr->self = cthread_self()) 153 154 #endif /* I_MACH_CTHREADS */ 155 156 #ifndef YIELD 157 # ifdef SCHED_YIELD 158 # define YIELD SCHED_YIELD 159 # elif defined(HAS_SCHED_YIELD) 160 # define YIELD sched_yield() 161 # elif defined(HAS_PTHREAD_YIELD) 162 /* pthread_yield(NULL) platforms are expected 163 * to have #defined YIELD for themselves. */ 164 # define YIELD pthread_yield() 165 # endif 166 #endif 167 168 #ifdef __hpux 169 # define MUTEX_INIT_NEEDS_MUTEX_ZEROED 170 #endif 171 172 #ifndef MUTEX_INIT 173 174 # ifdef MUTEX_INIT_NEEDS_MUTEX_ZEROED 175 /* Temporary workaround, true bug is deeper. --jhi 1999-02-25 */ 176 # define MUTEX_INIT(m) \ 177 STMT_START { \ 178 int _eC_; \ 179 Zero((m), 1, perl_mutex); \ 180 if ((_eC_ = pthread_mutex_init((m), pthread_mutexattr_default))) \ 181 Perl_croak_nocontext("panic: MUTEX_INIT (%d) [%s:%d]", \ 182 _eC_, __FILE__, __LINE__); \ 183 } STMT_END 184 # else 185 # define MUTEX_INIT(m) \ 186 STMT_START { \ 187 int _eC_; \ 188 if ((_eC_ = pthread_mutex_init((m), pthread_mutexattr_default))) \ 189 Perl_croak_nocontext("panic: MUTEX_INIT (%d) [%s:%d]", \ 190 _eC_, __FILE__, __LINE__); \ 191 } STMT_END 192 # endif 193 194 # ifdef PERL_TSA_ACTIVE 195 # define perl_pthread_mutex_lock(m) perl_tsa_mutex_lock(m) 196 # define perl_pthread_mutex_unlock(m) perl_tsa_mutex_unlock(m) 197 # else 198 # define perl_pthread_mutex_lock(m) pthread_mutex_lock(m) 199 # define perl_pthread_mutex_unlock(m) pthread_mutex_unlock(m) 200 # endif 201 202 # define MUTEX_LOCK(m) \ 203 STMT_START { \ 204 int _eC_; \ 205 if ((_eC_ = perl_pthread_mutex_lock((m)))) \ 206 Perl_croak_nocontext("panic: MUTEX_LOCK (%d) [%s:%d]", \ 207 _eC_, __FILE__, __LINE__); \ 208 } STMT_END 209 210 # define MUTEX_UNLOCK(m) \ 211 STMT_START { \ 212 int _eC_; \ 213 if ((_eC_ = perl_pthread_mutex_unlock((m)))) \ 214 Perl_croak_nocontext("panic: MUTEX_UNLOCK (%d) [%s:%d]", \ 215 _eC_, __FILE__, __LINE__); \ 216 } STMT_END 217 218 # define MUTEX_DESTROY(m) \ 219 STMT_START { \ 220 int _eC_; \ 221 if ((_eC_ = pthread_mutex_destroy((m)))) \ 222 Perl_croak_nocontext("panic: MUTEX_DESTROY (%d) [%s:%d]", \ 223 _eC_, __FILE__, __LINE__); \ 224 } STMT_END 225 #endif /* MUTEX_INIT */ 226 227 #ifndef COND_INIT 228 # define COND_INIT(c) \ 229 STMT_START { \ 230 int _eC_; \ 231 if ((_eC_ = pthread_cond_init((c), pthread_condattr_default))) \ 232 Perl_croak_nocontext("panic: COND_INIT (%d) [%s:%d]", \ 233 _eC_, __FILE__, __LINE__); \ 234 } STMT_END 235 236 # define COND_SIGNAL(c) \ 237 STMT_START { \ 238 int _eC_; \ 239 if ((_eC_ = pthread_cond_signal((c)))) \ 240 Perl_croak_nocontext("panic: COND_SIGNAL (%d) [%s:%d]", \ 241 _eC_, __FILE__, __LINE__); \ 242 } STMT_END 243 244 # define COND_BROADCAST(c) \ 245 STMT_START { \ 246 int _eC_; \ 247 if ((_eC_ = pthread_cond_broadcast((c)))) \ 248 Perl_croak_nocontext("panic: COND_BROADCAST (%d) [%s:%d]", \ 249 _eC_, __FILE__, __LINE__); \ 250 } STMT_END 251 252 # define COND_WAIT(c, m) \ 253 STMT_START { \ 254 int _eC_; \ 255 if ((_eC_ = pthread_cond_wait((c), (m)))) \ 256 Perl_croak_nocontext("panic: COND_WAIT (%d) [%s:%d]", \ 257 _eC_, __FILE__, __LINE__); \ 258 } STMT_END 259 260 # define COND_DESTROY(c) \ 261 STMT_START { \ 262 int _eC_; \ 263 if ((_eC_ = pthread_cond_destroy((c)))) \ 264 Perl_croak_nocontext("panic: COND_DESTROY (%d) [%s:%d]", \ 265 _eC_, __FILE__, __LINE__); \ 266 } STMT_END 267 #endif /* COND_INIT */ 268 269 #if defined(MUTEX_LOCK) && defined(MUTEX_UNLOCK) \ 270 && defined(COND_SIGNAL) && defined(COND_WAIT) 271 272 /* These emulate native many-reader/1-writer locks. 273 * Basically a locking reader just locks the semaphore long enough to increment 274 * a counter; and similarly decrements it when when through. Any writer will 275 * run only when the count of readers is 0. That is because it blocks on that 276 * semaphore (doing a COND_WAIT) until it gets control of it, which won't 277 * happen unless the count becomes 0. ALL readers and other writers are then 278 * blocked until it releases the semaphore. The reader whose unlocking causes 279 * the count to become 0 signals any waiting writers, and the system guarantees 280 * that only one gets control at a time */ 281 282 # define PERL_READ_LOCK(mutex) \ 283 STMT_START { \ 284 MUTEX_LOCK(&(mutex)->lock); \ 285 (mutex)->readers_count++; \ 286 MUTEX_UNLOCK(&(mutex)->lock); \ 287 } STMT_END 288 289 # define PERL_READ_UNLOCK(mutex) \ 290 STMT_START { \ 291 MUTEX_LOCK(&(mutex)->lock); \ 292 (mutex)->readers_count--; \ 293 if ((mutex)->readers_count <= 0) { \ 294 assert((mutex)->readers_count == 0); \ 295 COND_SIGNAL(&(mutex)->wakeup); \ 296 (mutex)->readers_count = 0; \ 297 } \ 298 MUTEX_UNLOCK(&(mutex)->lock); \ 299 } STMT_END 300 301 # define PERL_WRITE_LOCK(mutex) \ 302 STMT_START { \ 303 MUTEX_LOCK(&(mutex)->lock); \ 304 do { \ 305 if ((mutex)->readers_count <= 0) { \ 306 assert((mutex)->readers_count == 0); \ 307 (mutex)->readers_count = 0; \ 308 break; \ 309 } \ 310 COND_WAIT(&(mutex)->wakeup, &(mutex)->lock); \ 311 } \ 312 while (1); \ 313 \ 314 /* Here, the mutex is locked, with no readers */ \ 315 } STMT_END 316 317 # define PERL_WRITE_UNLOCK(mutex) \ 318 STMT_START { \ 319 COND_SIGNAL(&(mutex)->wakeup); \ 320 MUTEX_UNLOCK(&(mutex)->lock); \ 321 } STMT_END 322 323 # define PERL_RW_MUTEX_INIT(mutex) \ 324 STMT_START { \ 325 MUTEX_INIT(&(mutex)->lock); \ 326 COND_INIT(&(mutex)->wakeup); \ 327 (mutex)->readers_count = 0; \ 328 } STMT_END 329 330 # define PERL_RW_MUTEX_DESTROY(mutex) \ 331 STMT_START { \ 332 COND_DESTROY(&(mutex)->wakeup); \ 333 MUTEX_DESTROY(&(mutex)->lock); \ 334 } STMT_END 335 336 #endif 337 338 /* DETACH(t) must only be called while holding t->mutex */ 339 #ifndef DETACH 340 # define DETACH(t) \ 341 STMT_START { \ 342 int _eC_; \ 343 if ((_eC_ = pthread_detach((t)->self))) { \ 344 MUTEX_UNLOCK(&(t)->mutex); \ 345 Perl_croak_nocontext("panic: DETACH (%d) [%s:%d]", \ 346 _eC_, __FILE__, __LINE__); \ 347 } \ 348 } STMT_END 349 #endif /* DETACH */ 350 351 #ifndef JOIN 352 # define JOIN(t, avp) \ 353 STMT_START { \ 354 int _eC_; \ 355 if ((_eC_ = pthread_join((t)->self, (void**)(avp)))) \ 356 Perl_croak_nocontext("panic: pthread_join (%d) [%s:%d]", \ 357 _eC_, __FILE__, __LINE__); \ 358 } STMT_END 359 #endif /* JOIN */ 360 361 /* Use an unchecked fetch of thread-specific data instead of a checked one. 362 * It would fail if the key were bogus, but if the key were bogus then 363 * Really Bad Things would be happening anyway. --dan */ 364 #if (defined(__ALPHA) && (__VMS_VER >= 70000000)) || \ 365 (defined(__alpha) && defined(__osf__) && !defined(__GNUC__)) /* Available only on >= 4.0 */ 366 # define HAS_PTHREAD_UNCHECKED_GETSPECIFIC_NP /* Configure test needed */ 367 #endif 368 369 #ifdef HAS_PTHREAD_UNCHECKED_GETSPECIFIC_NP 370 # define PTHREAD_GETSPECIFIC(key) pthread_unchecked_getspecific_np(key) 371 #else 372 # define PTHREAD_GETSPECIFIC(key) pthread_getspecific(key) 373 #endif 374 375 #if defined(PERL_THREAD_LOCAL) && !defined(PERL_GET_CONTEXT) && !defined(PERL_SET_CONTEXT) && !defined(__cplusplus) 376 /* Use C11 thread-local storage, where possible. 377 * Frustratingly we can't use it for C++ extensions, C++ and C disagree on the 378 * syntax used for thread local storage, meaning that the working token that 379 * Configure probed for C turns out to be a compiler error on C++. Great. 380 * (Well, unless one or both is supporting non-standard syntax as an extension) 381 * As Configure doesn't have a way to probe for C++ dialects, we just take the 382 * safe option and do the same as 5.34.0 and earlier - use pthreads on C++. 383 * Of course, if C++ XS extensions really want to avoid *all* this overhead, 384 * they should #define PERL_NO_GET_CONTEXT and pass aTHX/aTHX_ explicitly) */ 385 # define PERL_USE_THREAD_LOCAL 386 extern PERL_THREAD_LOCAL void *PL_current_context; 387 388 # define PERL_GET_CONTEXT PL_current_context 389 390 /* We must also call pthread_setspecific() always, as C++ code has to read it 391 * with pthreads (the #else side just below) */ 392 393 # define PERL_SET_CONTEXT(t) \ 394 STMT_START { \ 395 int _eC_; \ 396 if ((_eC_ = pthread_setspecific(PL_thr_key, PL_current_context = (void *)(t)))) \ 397 Perl_croak_nocontext("panic: pthread_setspecific (%d) [%s:%d]", \ 398 _eC_, __FILE__, __LINE__); \ 399 } STMT_END 400 401 #else 402 /* else fall back to pthreads */ 403 404 # ifndef PERL_GET_CONTEXT 405 # define PERL_GET_CONTEXT PTHREAD_GETSPECIFIC(PL_thr_key) 406 # endif 407 408 /* For C++ extensions built on a system where the C compiler provides thread 409 * local storage that call PERL_SET_CONTEXT() also need to set 410 * PL_current_context, so need to call into C code to do this. 411 * To avoid exploding code complexity, do this also on C platforms that don't 412 * support thread local storage. PERL_SET_CONTEXT is not called that often. */ 413 414 # ifndef PERL_SET_CONTEXT 415 # define PERL_SET_CONTEXT(t) Perl_set_context((void*)t) 416 # endif /* PERL_SET_CONTEXT */ 417 #endif /* PERL_THREAD_LOCAL */ 418 419 #ifndef INIT_THREADS 420 # ifdef NEED_PTHREAD_INIT 421 # define INIT_THREADS pthread_init() 422 # endif 423 #endif 424 425 #ifndef ALLOC_THREAD_KEY 426 # define ALLOC_THREAD_KEY \ 427 STMT_START { \ 428 if (pthread_key_create(&PL_thr_key, 0)) { \ 429 PERL_UNUSED_RESULT(write(2, STR_WITH_LEN("panic: pthread_key_create failed\n"))); \ 430 exit(1); \ 431 } \ 432 } STMT_END 433 #endif 434 435 #ifndef FREE_THREAD_KEY 436 # define FREE_THREAD_KEY \ 437 STMT_START { \ 438 pthread_key_delete(PL_thr_key); \ 439 } STMT_END 440 #endif 441 442 #ifndef PTHREAD_ATFORK 443 # ifdef HAS_PTHREAD_ATFORK 444 # define PTHREAD_ATFORK(prepare,parent,child) \ 445 pthread_atfork(prepare,parent,child) 446 # else 447 # define PTHREAD_ATFORK(prepare,parent,child) \ 448 NOOP 449 # endif 450 #endif 451 452 #ifndef THREAD_RET_TYPE 453 # define THREAD_RET_TYPE void * 454 #endif /* THREAD_RET */ 455 456 # define LOCK_DOLLARZERO_MUTEX MUTEX_LOCK(&PL_dollarzero_mutex) 457 # define UNLOCK_DOLLARZERO_MUTEX MUTEX_UNLOCK(&PL_dollarzero_mutex) 458 459 #endif /* USE_ITHREADS */ 460 461 #ifndef MUTEX_LOCK 462 # define MUTEX_LOCK(m) NOOP 463 #endif 464 465 #ifndef MUTEX_UNLOCK 466 # define MUTEX_UNLOCK(m) NOOP 467 #endif 468 469 #ifndef MUTEX_INIT 470 # define MUTEX_INIT(m) NOOP 471 #endif 472 473 #ifndef MUTEX_DESTROY 474 # define MUTEX_DESTROY(m) NOOP 475 #endif 476 477 #ifndef COND_INIT 478 # define COND_INIT(c) NOOP 479 #endif 480 481 #ifndef COND_SIGNAL 482 # define COND_SIGNAL(c) NOOP 483 #endif 484 485 #ifndef COND_BROADCAST 486 # define COND_BROADCAST(c) NOOP 487 #endif 488 489 #ifndef COND_WAIT 490 # define COND_WAIT(c, m) NOOP 491 #endif 492 493 #ifndef COND_DESTROY 494 # define COND_DESTROY(c) NOOP 495 #endif 496 497 #ifndef PERL_READ_LOCK 498 # define PERL_READ_LOCK NOOP 499 # define PERL_READ_UNLOCK NOOP 500 # define PERL_WRITE_LOCK NOOP 501 # define PERL_WRITE_UNLOCK NOOP 502 # define PERL_RW_MUTEX_INIT NOOP 503 # define PERL_RW_MUTEX_DESTROY NOOP 504 #endif 505 506 #ifndef LOCK_DOLLARZERO_MUTEX 507 # define LOCK_DOLLARZERO_MUTEX NOOP 508 #endif 509 510 #ifndef UNLOCK_DOLLARZERO_MUTEX 511 # define UNLOCK_DOLLARZERO_MUTEX NOOP 512 #endif 513 514 /* THR, SET_THR, and dTHR are there for compatibility with old versions */ 515 #ifndef THR 516 # define THR PERL_GET_THX 517 #endif 518 519 #ifndef SET_THR 520 # define SET_THR(t) PERL_SET_THX(t) 521 #endif 522 523 #ifndef dTHR 524 # define dTHR dNOOP 525 #endif 526 527 #ifndef INIT_THREADS 528 # define INIT_THREADS NOOP 529 #endif 530 531 /* 532 * ex: set ts=8 sts=4 sw=4 et: 533 */ 534