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 dSAVE_ERRNO; \ 205 int _eC_; \ 206 if ((_eC_ = perl_pthread_mutex_lock((m)))) \ 207 Perl_croak_nocontext("panic: MUTEX_LOCK (%d) [%s:%d]",\ 208 _eC_, __FILE__, __LINE__); \ 209 RESTORE_ERRNO; \ 210 } STMT_END 211 212 # define MUTEX_UNLOCK(m) \ 213 STMT_START { \ 214 dSAVE_ERRNO; /* Shouldn't be necessary as panics if fails */\ 215 int _eC_; \ 216 if ((_eC_ = perl_pthread_mutex_unlock((m)))) { \ 217 Perl_croak_nocontext( \ 218 "panic: MUTEX_UNLOCK (%d) [%s:%d]", \ 219 _eC_, __FILE__, __LINE__); \ 220 } \ 221 RESTORE_ERRNO; \ 222 } STMT_END 223 224 # define MUTEX_DESTROY(m) \ 225 STMT_START { \ 226 int _eC_; \ 227 if ((_eC_ = pthread_mutex_destroy((m)))) { \ 228 dTHX; \ 229 if (PL_phase != PERL_PHASE_DESTRUCT) { \ 230 Perl_croak_nocontext("panic: MUTEX_DESTROY (%d) [%s:%d]", \ 231 _eC_, __FILE__, __LINE__); \ 232 } \ 233 } \ 234 } STMT_END 235 #endif /* MUTEX_INIT */ 236 237 #ifndef COND_INIT 238 # define COND_INIT(c) \ 239 STMT_START { \ 240 int _eC_; \ 241 if ((_eC_ = pthread_cond_init((c), pthread_condattr_default))) \ 242 Perl_croak_nocontext("panic: COND_INIT (%d) [%s:%d]", \ 243 _eC_, __FILE__, __LINE__); \ 244 } STMT_END 245 246 # define COND_SIGNAL(c) \ 247 STMT_START { \ 248 int _eC_; \ 249 if ((_eC_ = pthread_cond_signal((c)))) \ 250 Perl_croak_nocontext("panic: COND_SIGNAL (%d) [%s:%d]", \ 251 _eC_, __FILE__, __LINE__); \ 252 } STMT_END 253 254 # define COND_BROADCAST(c) \ 255 STMT_START { \ 256 int _eC_; \ 257 if ((_eC_ = pthread_cond_broadcast((c)))) \ 258 Perl_croak_nocontext("panic: COND_BROADCAST (%d) [%s:%d]", \ 259 _eC_, __FILE__, __LINE__); \ 260 } STMT_END 261 262 # define COND_WAIT(c, m) \ 263 STMT_START { \ 264 int _eC_; \ 265 if ((_eC_ = pthread_cond_wait((c), (m)))) \ 266 Perl_croak_nocontext("panic: COND_WAIT (%d) [%s:%d]", \ 267 _eC_, __FILE__, __LINE__); \ 268 } STMT_END 269 270 # define COND_DESTROY(c) \ 271 STMT_START { \ 272 int _eC_; \ 273 if ((_eC_ = pthread_cond_destroy((c)))) { \ 274 dTHX; \ 275 if (PL_phase != PERL_PHASE_DESTRUCT) { \ 276 Perl_croak_nocontext("panic: COND_DESTROY (%d) [%s:%d]", \ 277 _eC_, __FILE__, __LINE__); \ 278 } \ 279 } \ 280 } STMT_END 281 #endif /* COND_INIT */ 282 283 #if defined(MUTEX_LOCK) && defined(MUTEX_UNLOCK) \ 284 && defined(COND_SIGNAL) && defined(COND_WAIT) 285 286 /* These emulate native many-reader/1-writer locks. 287 * Basically a locking reader just locks the semaphore long enough to increment 288 * a counter; and similarly decrements it when when through. Any writer will 289 * run only when the count of readers is 0. That is because it blocks on that 290 * semaphore (doing a COND_WAIT) until it gets control of it, which won't 291 * happen unless the count becomes 0. ALL readers and other writers are then 292 * blocked until it releases the semaphore. The reader whose unlocking causes 293 * the count to become 0 signals any waiting writers, and the system guarantees 294 * that only one gets control at a time */ 295 296 # define PERL_READ_LOCK(mutex) \ 297 STMT_START { \ 298 MUTEX_LOCK(&(mutex)->lock); \ 299 (mutex)->readers_count++; \ 300 MUTEX_UNLOCK(&(mutex)->lock); \ 301 } STMT_END 302 303 # define PERL_READ_UNLOCK(mutex) \ 304 STMT_START { \ 305 MUTEX_LOCK(&(mutex)->lock); \ 306 (mutex)->readers_count--; \ 307 if ((mutex)->readers_count <= 0) { \ 308 assert((mutex)->readers_count == 0); \ 309 COND_SIGNAL(&(mutex)->wakeup); \ 310 (mutex)->readers_count = 0; \ 311 } \ 312 MUTEX_UNLOCK(&(mutex)->lock); \ 313 } STMT_END 314 315 # define PERL_WRITE_LOCK(mutex) \ 316 STMT_START { \ 317 MUTEX_LOCK(&(mutex)->lock); \ 318 do { \ 319 if ((mutex)->readers_count <= 0) { \ 320 assert((mutex)->readers_count == 0); \ 321 (mutex)->readers_count = 0; \ 322 break; \ 323 } \ 324 COND_WAIT(&(mutex)->wakeup, &(mutex)->lock); \ 325 } \ 326 while (1); \ 327 \ 328 /* Here, the mutex is locked, with no readers */ \ 329 } STMT_END 330 331 # define PERL_WRITE_UNLOCK(mutex) \ 332 STMT_START { \ 333 COND_SIGNAL(&(mutex)->wakeup); \ 334 MUTEX_UNLOCK(&(mutex)->lock); \ 335 } STMT_END 336 337 # define PERL_RW_MUTEX_INIT(mutex) \ 338 STMT_START { \ 339 MUTEX_INIT(&(mutex)->lock); \ 340 COND_INIT(&(mutex)->wakeup); \ 341 (mutex)->readers_count = 0; \ 342 } STMT_END 343 344 # define PERL_RW_MUTEX_DESTROY(mutex) \ 345 STMT_START { \ 346 COND_DESTROY(&(mutex)->wakeup); \ 347 MUTEX_DESTROY(&(mutex)->lock); \ 348 } STMT_END 349 350 #endif 351 352 /* DETACH(t) must only be called while holding t->mutex */ 353 #ifndef DETACH 354 # define DETACH(t) \ 355 STMT_START { \ 356 int _eC_; \ 357 if ((_eC_ = pthread_detach((t)->self))) { \ 358 MUTEX_UNLOCK(&(t)->mutex); \ 359 Perl_croak_nocontext("panic: DETACH (%d) [%s:%d]", \ 360 _eC_, __FILE__, __LINE__); \ 361 } \ 362 } STMT_END 363 #endif /* DETACH */ 364 365 #ifndef JOIN 366 # define JOIN(t, avp) \ 367 STMT_START { \ 368 int _eC_; \ 369 if ((_eC_ = pthread_join((t)->self, (void**)(avp)))) \ 370 Perl_croak_nocontext("panic: pthread_join (%d) [%s:%d]", \ 371 _eC_, __FILE__, __LINE__); \ 372 } STMT_END 373 #endif /* JOIN */ 374 375 /* Use an unchecked fetch of thread-specific data instead of a checked one. 376 * It would fail if the key were bogus, but if the key were bogus then 377 * Really Bad Things would be happening anyway. --dan */ 378 #if (defined(__ALPHA) && (__VMS_VER >= 70000000)) || \ 379 (defined(__alpha) && defined(__osf__) && !defined(__GNUC__)) /* Available only on >= 4.0 */ 380 # define HAS_PTHREAD_UNCHECKED_GETSPECIFIC_NP /* Configure test needed */ 381 #endif 382 383 #ifdef HAS_PTHREAD_UNCHECKED_GETSPECIFIC_NP 384 # define PTHREAD_GETSPECIFIC(key) pthread_unchecked_getspecific_np(key) 385 #else 386 # define PTHREAD_GETSPECIFIC(key) pthread_getspecific(key) 387 #endif 388 389 #if defined(PERL_THREAD_LOCAL) && !defined(PERL_GET_CONTEXT) && !defined(PERL_SET_CONTEXT) && !defined(__cplusplus) 390 /* Use C11 thread-local storage, where possible. 391 * Frustratingly we can't use it for C++ extensions, C++ and C disagree on the 392 * syntax used for thread local storage, meaning that the working token that 393 * Configure probed for C turns out to be a compiler error on C++. Great. 394 * (Well, unless one or both is supporting non-standard syntax as an extension) 395 * As Configure doesn't have a way to probe for C++ dialects, we just take the 396 * safe option and do the same as 5.34.0 and earlier - use pthreads on C++. 397 * Of course, if C++ XS extensions really want to avoid *all* this overhead, 398 * they should #define PERL_NO_GET_CONTEXT and pass aTHX/aTHX_ explicitly) */ 399 # define PERL_USE_THREAD_LOCAL 400 extern PERL_THREAD_LOCAL void *PL_current_context; 401 402 # define PERL_GET_CONTEXT PL_current_context 403 404 /* We must also call pthread_setspecific() always, as C++ code has to read it 405 * with pthreads (the #else side just below) */ 406 407 # define PERL_SET_CONTEXT(t) \ 408 STMT_START { \ 409 int _eC_; \ 410 if ((_eC_ = pthread_setspecific(PL_thr_key, \ 411 PL_current_context = (void *)(t)))) \ 412 Perl_croak_nocontext("panic: pthread_setspecific (%d) [%s:%d]", \ 413 _eC_, __FILE__, __LINE__); \ 414 PERL_SET_NON_tTHX_CONTEXT(t); \ 415 } STMT_END 416 417 #else 418 /* else fall back to pthreads */ 419 420 # ifndef PERL_GET_CONTEXT 421 # define PERL_GET_CONTEXT PTHREAD_GETSPECIFIC(PL_thr_key) 422 # endif 423 424 /* For C++ extensions built on a system where the C compiler provides thread 425 * local storage that call PERL_SET_CONTEXT() also need to set 426 * PL_current_context, so need to call into C code to do this. 427 * To avoid exploding code complexity, do this also on C platforms that don't 428 * support thread local storage. PERL_SET_CONTEXT is not called that often. */ 429 430 # ifndef PERL_SET_CONTEXT 431 # define PERL_SET_CONTEXT(t) Perl_set_context((void*)t) 432 # endif /* PERL_SET_CONTEXT */ 433 #endif /* PERL_THREAD_LOCAL */ 434 435 #ifndef INIT_THREADS 436 # ifdef NEED_PTHREAD_INIT 437 # define INIT_THREADS pthread_init() 438 # endif 439 #endif 440 441 #ifndef ALLOC_THREAD_KEY 442 # define ALLOC_THREAD_KEY \ 443 STMT_START { \ 444 if (pthread_key_create(&PL_thr_key, 0)) { \ 445 PERL_UNUSED_RESULT(write(2, STR_WITH_LEN("panic: pthread_key_create failed\n"))); \ 446 exit(1); \ 447 } \ 448 } STMT_END 449 #endif 450 451 #ifndef FREE_THREAD_KEY 452 # define FREE_THREAD_KEY \ 453 STMT_START { \ 454 pthread_key_delete(PL_thr_key); \ 455 } STMT_END 456 #endif 457 458 #ifndef PTHREAD_ATFORK 459 # ifdef HAS_PTHREAD_ATFORK 460 # define PTHREAD_ATFORK(prepare,parent,child) \ 461 pthread_atfork(prepare,parent,child) 462 # else 463 # define PTHREAD_ATFORK(prepare,parent,child) \ 464 NOOP 465 # endif 466 #endif 467 468 #ifndef THREAD_RET_TYPE 469 # define THREAD_RET_TYPE void * 470 #endif /* THREAD_RET */ 471 472 # define LOCK_DOLLARZERO_MUTEX MUTEX_LOCK(&PL_dollarzero_mutex) 473 # define UNLOCK_DOLLARZERO_MUTEX MUTEX_UNLOCK(&PL_dollarzero_mutex) 474 475 #endif /* USE_ITHREADS */ 476 477 #ifndef MUTEX_LOCK 478 # define MUTEX_LOCK(m) NOOP 479 #endif 480 481 #ifndef MUTEX_UNLOCK 482 # define MUTEX_UNLOCK(m) NOOP 483 #endif 484 485 #ifndef MUTEX_INIT 486 # define MUTEX_INIT(m) NOOP 487 #endif 488 489 #ifndef MUTEX_DESTROY 490 # define MUTEX_DESTROY(m) NOOP 491 #endif 492 493 #ifndef COND_INIT 494 # define COND_INIT(c) NOOP 495 #endif 496 497 #ifndef COND_SIGNAL 498 # define COND_SIGNAL(c) NOOP 499 #endif 500 501 #ifndef COND_BROADCAST 502 # define COND_BROADCAST(c) NOOP 503 #endif 504 505 #ifndef COND_WAIT 506 # define COND_WAIT(c, m) NOOP 507 #endif 508 509 #ifndef COND_DESTROY 510 # define COND_DESTROY(c) NOOP 511 #endif 512 513 #ifndef PERL_READ_LOCK 514 # define PERL_READ_LOCK NOOP 515 # define PERL_READ_UNLOCK NOOP 516 # define PERL_WRITE_LOCK NOOP 517 # define PERL_WRITE_UNLOCK NOOP 518 # define PERL_RW_MUTEX_INIT NOOP 519 # define PERL_RW_MUTEX_DESTROY NOOP 520 #endif 521 522 #ifndef LOCK_DOLLARZERO_MUTEX 523 # define LOCK_DOLLARZERO_MUTEX NOOP 524 #endif 525 526 #ifndef UNLOCK_DOLLARZERO_MUTEX 527 # define UNLOCK_DOLLARZERO_MUTEX NOOP 528 #endif 529 530 /* THR, SET_THR, and dTHR are there for compatibility with old versions */ 531 #ifndef THR 532 # define THR PERL_GET_THX 533 #endif 534 535 #ifndef SET_THR 536 # define SET_THR(t) PERL_SET_THX(t) 537 #endif 538 539 #ifndef dTHR 540 # define dTHR dNOOP 541 #endif 542 543 #ifndef INIT_THREADS 544 # define INIT_THREADS NOOP 545 #endif 546 547 /* 548 * ex: set ts=8 sts=4 sw=4 et: 549 */ 550