ext/threads/threads.xs

   1 #define PERL_NO_GET_CONTEXT
   2 #include "EXTERN.h"
   3 #include "perl.h"
   4 #include "XSUB.h"
   5 /* Workaround for XSUB.h bug under WIN32 */
   6 #ifdef WIN32
   7 #  undef setjmp
   8 #  if !defined(__BORLANDC__)
   9 #    define setjmp(x) _setjmp(x)
  10 #  endif
  11 #endif
  12 #ifdef HAS_PPPORT_H
  13 #  define NEED_PL_signals
  14 #  define NEED_newRV_noinc
  15 #  define NEED_sv_2pv_nolen
  16 #  include "ppport.h"
  17 #  include "threads.h"
  18 #endif
  19
  20 #ifdef USE_ITHREADS
  21
  22 #ifdef WIN32
  23 #  include <windows.h>
  24    /* Supposed to be in Winbase.h */
  25 #  ifndef STACK_SIZE_PARAM_IS_A_RESERVATION
  26 #    define STACK_SIZE_PARAM_IS_A_RESERVATION 0x00010000
  27 #  endif
  28 #  include <win32thread.h>
  29 #else
  30 #  ifdef OS2
  31 typedef perl_os_thread pthread_t;
  32 #  else
  33 #    include <pthread.h>
  34 #  endif
  35 #  include <thread.h>
  36 #  define PERL_THREAD_SETSPECIFIC(k,v) pthread_setspecific(k,v)
  37 #  ifdef OLD_PTHREADS_API
  38 #    define PERL_THREAD_DETACH(t) pthread_detach(&(t))
  39 #  else
  40 #    define PERL_THREAD_DETACH(t) pthread_detach((t))
  41 #  endif
  42 #endif
  43 #if !defined(HAS_GETPAGESIZE) && defined(I_SYS_PARAM)
  44 #  include <sys/param.h>
  45 #endif
  46
  47 /* Values for 'state' member */
  48 #define PERL_ITHR_JOINABLE              0
  49 #define PERL_ITHR_DETACHED              1
  50 #define PERL_ITHR_JOINED                2
  51 #define PERL_ITHR_FINISHED              4
  52 #define PERL_ITHR_THREAD_EXIT_ONLY      8
  53
  54 typedef struct _ithread {
  55     struct _ithread *next;      /* Next thread in the list */
  56     struct _ithread *prev;      /* Prev thread in the list */
  57     PerlInterpreter *interp;    /* The threads interpreter */
  58     UV tid;                     /* Threads module's thread id */
  59     perl_mutex mutex;           /* Mutex for updating things in this struct */
  60     int count;                  /* How many SVs have a reference to us */
  61     int state;                  /* Detached, joined, finished, etc. */
  62     int gimme;                  /* Context of create */
  63     SV *init_function;          /* Code to run */
  64     SV *params;                 /* Args to pass function */
  65 #ifdef WIN32
  66     DWORD  thr;                 /* OS's idea if thread id */
  67     HANDLE handle;              /* OS's waitable handle */
  68 #else
  69     pthread_t thr;              /* OS's handle for the thread */
  70 #endif
  71     IV stack_size;
  72 } ithread;
  73
  74
  75 /* Used by Perl interpreter for thread context switching */
  76 #define MY_CXT_KEY "threads::_guts" XS_VERSION
  77
  78 typedef struct {
  79     ithread *thread;
  80 } my_cxt_t;
  81
  82 START_MY_CXT
  83
  84 /* Structure for 'main' thread
  85  * Also forms the 'base' for the doubly-linked list of threads */
  86 static ithread main_thread;
  87
  88 /* Protects the creation and destruction of threads*/
  89 static perl_mutex create_destruct_mutex;
  90
  91 static UV tid_counter = 1;
  92 static IV joinable_threads = 0;
  93 static IV running_threads = 0;
  94 static IV detached_threads = 0;
  95 #ifdef THREAD_CREATE_NEEDS_STACK
  96 static IV default_stack_size = THREAD_CREATE_NEEDS_STACK;
  97 #else
  98 static IV default_stack_size = 0;
  99 #endif
 100 static IV page_size = 0;
 101
 102
 103 /* Used by Perl interpreter for thread context switching */
 104 static void
 105 S_ithread_set(pTHX_ ithread *thread)
 106 {
 107     dMY_CXT;
 108     MY_CXT.thread = thread;
 109 }
 110
 111 static ithread *
 112 S_ithread_get(pTHX)
 113 {
 114     dMY_CXT;
 115     return (MY_CXT.thread);
 116 }
 117
 118
 119 /* Free any data (such as the Perl interpreter) attached to an ithread
 120  * structure.  This is a bit like undef on SVs, where the SV isn't freed,
 121  * but the PVX is.  Must be called with thread->mutex already held.
 122  */
 123 static void
 124 S_ithread_clear(pTHX_ ithread *thread)
 125 {
 126     PerlInterpreter *interp;
 127
 128     assert((thread->state & PERL_ITHR_FINISHED) &&
 129            (thread->state & (PERL_ITHR_DETACHED|PERL_ITHR_JOINED)));
 130
 131     interp = thread->interp;
 132     if (interp) {
 133         dTHXa(interp);
 134
 135         PERL_SET_CONTEXT(interp);
 136         S_ithread_set(aTHX_ thread);
 137
 138         SvREFCNT_dec(thread->params);
 139         thread->params = Nullsv;
 140
 141         perl_destruct(interp);
 142         perl_free(interp);
 143         thread->interp = NULL;
 144     }
 145
 146     PERL_SET_CONTEXT(aTHX);
 147 }
 148
 149
 150 /* Free an ithread structure and any attached data if its count == 0 */
 151 static void
 152 S_ithread_destruct(pTHX_ ithread *thread)
 153 {
 154 #ifdef WIN32
 155     HANDLE handle;
 156 #endif
 157     /* Thread is still in use */
 158     if (thread->count != 0) {
 159         return;
 160     }
 161
 162     /* Main thread (0) is immortal and should never get here */
 163     assert(thread->tid != 0);
 164
 165     /* Remove from circular list of threads */
 166     MUTEX_LOCK(&create_destruct_mutex);
 167     thread->next->prev = thread->prev;
 168     thread->prev->next = thread->next;
 169     thread->next = NULL;
 170     thread->prev = NULL;
 171     MUTEX_UNLOCK(&create_destruct_mutex);
 172
 173     /* Thread is now disowned */
 174     MUTEX_LOCK(&thread->mutex);
 175     S_ithread_clear(aTHX_ thread);
 176
 177 #ifdef WIN32
 178     handle = thread->handle;
 179     thread->handle = NULL;
 180 #endif
 181     MUTEX_UNLOCK(&thread->mutex);
 182     MUTEX_DESTROY(&thread->mutex);
 183
 184 #ifdef WIN32
 185     if (handle)
 186         CloseHandle(handle);
 187 #endif
 188
 189     /* Call PerlMemShared_free() in the context of the "first" interpreter
 190      * per http://www.nntp.perl.org/group/perl.perl5.porters/110772
 191      */
 192     aTHX = PL_curinterp;
 193     PerlMemShared_free(thread);
 194 }
 195
 196
 197 /* Warn if exiting with any unjoined threads */
 198 static int
 199 S_exit_warning(pTHX)
 200 {
 201     int veto_cleanup;
 202
 203     MUTEX_LOCK(&create_destruct_mutex);
 204     veto_cleanup = (running_threads || joinable_threads);
 205     MUTEX_UNLOCK(&create_destruct_mutex);
 206
 207     if (veto_cleanup) {
 208         if (ckWARN_d(WARN_THREADS)) {
 209             Perl_warn(aTHX_ "Perl exited with active threads:\n\t%"
 210                             IVdf " running and unjoined\n\t%"
 211                             IVdf " finished and unjoined\n\t%"
 212                             IVdf " running and detached\n",
 213                             running_threads,
 214                             joinable_threads,
 215                             detached_threads);
 216         }
 217     }
 218
 219     return (veto_cleanup);
 220 }
 221
 222 /* Called on exit from main thread */
 223 int
 224 Perl_ithread_hook(pTHX)
 225 {
 226     return ((aTHX == PL_curinterp) ? S_exit_warning(aTHX) : 0);
 227 }
 228
 229
 230 /* MAGIC (in mg.h sense) hooks */
 231
 232 int
 233 ithread_mg_get(pTHX_ SV *sv, MAGIC *mg)
 234 {
 235     ithread *thread = (ithread *)mg->mg_ptr;
 236     SvIV_set(sv, PTR2IV(thread));
 237     SvIOK_on(sv);
 238     return (0);
 239 }
 240
 241 int
 242 ithread_mg_free(pTHX_ SV *sv, MAGIC *mg)
 243 {
 244     ithread *thread = (ithread *)mg->mg_ptr;
 245     int cleanup;
 246
 247     MUTEX_LOCK(&thread->mutex);
 248     cleanup = ((--thread->count == 0) &&
 249                (thread->state & PERL_ITHR_FINISHED) &&
 250                (thread->state & (PERL_ITHR_DETACHED|PERL_ITHR_JOINED)));
 251     MUTEX_UNLOCK(&thread->mutex);
 252
 253     if (cleanup)
 254         S_ithread_destruct(aTHX_ thread);
 255     return (0);
 256 }
 257
 258 int
 259 ithread_mg_dup(pTHX_ MAGIC *mg, CLONE_PARAMS *param)
 260 {
 261     ithread *thread = (ithread *)mg->mg_ptr;
 262     MUTEX_LOCK(&thread->mutex);
 263     thread->count++;
 264     MUTEX_UNLOCK(&thread->mutex);
 265     return (0);
 266 }
 267
 268 MGVTBL ithread_vtbl = {
 269     ithread_mg_get,     /* get */
 270     0,                  /* set */
 271     0,                  /* len */
 272     0,                  /* clear */
 273     ithread_mg_free,    /* free */
 274     0,                  /* copy */
 275     ithread_mg_dup      /* dup */
 276 };
 277
 278
 279 /* Provided default, minimum and rational stack sizes */
 280 static IV
 281 good_stack_size(pTHX_ IV stack_size)
 282 {
 283     /* Use default stack size if no stack size specified */
 284     if (! stack_size)
 285         return (default_stack_size);
 286
 287 #ifdef PTHREAD_STACK_MIN
 288     /* Can't use less than minimum */
 289     if (stack_size < PTHREAD_STACK_MIN) {
 290         if (ckWARN(WARN_THREADS)) {
 291             Perl_warn(aTHX_ "Using minimum thread stack size of %" IVdf, (IV)PTHREAD_STACK_MIN);
 292         }
 293         return (PTHREAD_STACK_MIN);
 294     }
 295 #endif
 296
 297     /* Round up to page size boundary */
 298     if (page_size <= 0) {
 299 #if defined(HAS_SYSCONF) && (defined(_SC_PAGESIZE) || defined(_SC_MMAP_PAGE_SIZE))
 300         SETERRNO(0, SS_NORMAL);
 301 #  ifdef _SC_PAGESIZE
 302         page_size = sysconf(_SC_PAGESIZE);
 303 #  else
 304         page_size = sysconf(_SC_MMAP_PAGE_SIZE);
 305 #  endif
 306         if ((long)page_size < 0) {
 307             if (errno) {
 308                 SV * const error = get_sv("@", FALSE);
 309                 (void)SvUPGRADE(error, SVt_PV);
 310                 Perl_croak(aTHX_ "PANIC: sysconf: %s", SvPV_nolen(error));
 311             } else {
 312                 Perl_croak(aTHX_ "PANIC: sysconf: pagesize unknown");
 313             }
 314         }
 315 #else
 316 #  ifdef HAS_GETPAGESIZE
 317         page_size = getpagesize();
 318 #  else
 319 #    if defined(I_SYS_PARAM) && defined(PAGESIZE)
 320         page_size = PAGESIZE;
 321 #    else
 322         page_size = 8192;   /* A conservative default */
 323 #    endif
 324 #  endif
 325         if (page_size <= 0)
 326             Perl_croak(aTHX_ "PANIC: bad pagesize %" IVdf, (IV)page_size);
 327 #endif
 328     }
 329     stack_size = ((stack_size + (page_size - 1)) / page_size) * page_size;
 330
 331     return (stack_size);
 332 }
 333
 334
 335 /* Starts executing the thread.
 336  * Passed as the C level function to run in the new thread.
 337  */
 338 #ifdef WIN32
 339 static THREAD_RET_TYPE
 340 S_ithread_run(LPVOID arg)
 341 #else
 342 static void *
 343 S_ithread_run(void * arg)
 344 #endif
 345 {
 346     ithread *thread = (ithread *)arg;
 347     int jmp_rc = 0;
 348     I32 oldscope;
 349     int exit_app = 0;
 350     int exit_code = 0;
 351     int cleanup;
 352
 353     dJMPENV;
 354
 355     dTHXa(thread->interp);
 356
 357     /* Blocked until ->create() call finishes */
 358     MUTEX_LOCK(&thread->mutex);
 359     MUTEX_UNLOCK(&thread->mutex);
 360
 361     PERL_SET_CONTEXT(thread->interp);
 362     S_ithread_set(aTHX_ thread);
 363
 364     PL_perl_destruct_level = 2;
 365
 366     {
 367         AV *params = (AV *)SvRV(thread->params);
 368         int len = (int)av_len(params)+1;
 369         int ii;
 370
 371         dSP;
 372         ENTER;
 373         SAVETMPS;
 374
 375         /* Put args on the stack */
 376         PUSHMARK(SP);
 377         for (ii=0; ii < len; ii++) {
 378             XPUSHs(av_shift(params));
 379         }
 380         PUTBACK;
 381
 382         oldscope = PL_scopestack_ix;
 383         JMPENV_PUSH(jmp_rc);
 384         if (jmp_rc == 0) {
 385             /* Run the specified function */
 386             len = (int)call_sv(thread->init_function, thread->gimme|G_EVAL);
 387         } else if (jmp_rc == 2) {
 388             /* Thread exited */
 389             exit_app = 1;
 390             exit_code = STATUS_CURRENT;
 391             while (PL_scopestack_ix > oldscope) {
 392                 LEAVE;
 393             }
 394         }
 395         JMPENV_POP;
 396
 397         /* Remove args from stack and put back in params array */
 398         SPAGAIN;
 399         for (ii=len-1; ii >= 0; ii--) {
 400             SV *sv = POPs;
 401             if (jmp_rc == 0) {
 402                 av_store(params, ii, SvREFCNT_inc(sv));
 403             }
 404         }
 405
 406         FREETMPS;
 407         LEAVE;
 408
 409         /* Check for failure */
 410         if (SvTRUE(ERRSV) && ckWARN_d(WARN_THREADS)) {
 411             oldscope = PL_scopestack_ix;
 412             JMPENV_PUSH(jmp_rc);
 413             if (jmp_rc == 0) {
 414                 /* Warn that thread died */
 415                 Perl_warn(aTHX_ "Thread %" UVuf " terminated abnormally: %" SVf, thread->tid, ERRSV);
 416             } else if (jmp_rc == 2) {
 417                 /* Warn handler exited */
 418                 exit_app = 1;
 419                 exit_code = STATUS_CURRENT;
 420                 while (PL_scopestack_ix > oldscope) {
 421                     LEAVE;
 422                 }
 423             }
 424             JMPENV_POP;
 425         }
 426
 427         /* Release function ref */
 428         SvREFCNT_dec(thread->init_function);
 429         thread->init_function = Nullsv;
 430     }
 431
 432     PerlIO_flush((PerlIO *)NULL);
 433
 434     MUTEX_LOCK(&create_destruct_mutex);
 435     MUTEX_LOCK(&thread->mutex);
 436     /* Mark as finished */
 437     thread->state |= PERL_ITHR_FINISHED;
 438     /* Clear exit flag if required */
 439     if (thread->state & PERL_ITHR_THREAD_EXIT_ONLY)
 440         exit_app = 0;
 441     /* Cleanup if detached */
 442     cleanup = (thread->state & PERL_ITHR_DETACHED);
 443     MUTEX_UNLOCK(&thread->mutex);
 444
 445     /* Adjust thread status counts */
 446     if (cleanup) {
 447         detached_threads--;
 448     } else {
 449         running_threads--;
 450         joinable_threads++;
 451     }
 452     MUTEX_UNLOCK(&create_destruct_mutex);
 453
 454     /* Exit application if required */
 455     if (exit_app) {
 456         oldscope = PL_scopestack_ix;
 457         JMPENV_PUSH(jmp_rc);
 458         if (jmp_rc == 0) {
 459             /* Warn if there are unjoined threads */
 460             S_exit_warning(aTHX);
 461         } else if (jmp_rc == 2) {
 462             /* Warn handler exited */
 463             exit_code = STATUS_CURRENT;
 464             while (PL_scopestack_ix > oldscope) {
 465                 LEAVE;
 466             }
 467         }
 468         JMPENV_POP;
 469
 470         my_exit(exit_code);
 471     }
 472
 473     /* Clean up detached thread */
 474     if (cleanup)
 475         S_ithread_destruct(aTHX_ thread);
 476
 477 #ifdef WIN32
 478     return ((DWORD)0);
 479 #else
 480     return (0);
 481 #endif
 482 }
 483
 484
 485 /* Type conversion helper functions */
 486 static SV *
 487 ithread_to_SV(pTHX_ SV *obj, ithread *thread, char *classname, bool inc)
 488 {
 489     SV *sv;
 490     MAGIC *mg;
 491
 492     /* If incrementing thread ref count, then call within mutex lock */
 493     if (inc) {
 494         MUTEX_LOCK(&thread->mutex);
 495         thread->count++;
 496         MUTEX_UNLOCK(&thread->mutex);
 497     }
 498
 499     if (! obj) {
 500         obj = newSV(0);
 501     }
 502
 503     sv = newSVrv(obj, classname);
 504     sv_setiv(sv, PTR2IV(thread));
 505     mg = sv_magicext(sv, Nullsv, PERL_MAGIC_shared_scalar, &ithread_vtbl, (char *)thread, 0);
 506     mg->mg_flags |= MGf_DUP;
 507     SvREADONLY_on(sv);
 508
 509     return (obj);
 510 }
 511
 512 static ithread *
 513 SV_to_ithread(pTHX_ SV *sv)
 514 {
 515     /* Argument is a thread */
 516     if (SvROK(sv)) {
 517       return (INT2PTR(ithread *, SvIV(SvRV(sv))));
 518     }
 519     /* Argument is classname, therefore return current thread */
 520     return (S_ithread_get(aTHX));
 521 }
 522
 523
 524 /* threads->create()
 525  * Called in context of parent thread.
 526  * Called with create_destruct_mutex locked.  (Unlocked on error.)
 527  */
 528 static ithread *
 529 S_ithread_create(
 530         pTHX_ SV *init_function,
 531         IV        stack_size,
 532         int       gimme,
 533         int       exit_opt,
 534         SV       *params)
 535 {
 536     ithread     *thread;
 537     CLONE_PARAMS clone_param;
 538     ithread     *current_thread = S_ithread_get(aTHX);
 539
 540     SV         **tmps_tmp = PL_tmps_stack;
 541     IV           tmps_ix  = PL_tmps_ix;
 542 #ifndef WIN32
 543     int          rc_stack_size = 0;
 544     int          rc_thread_create = 0;
 545 #endif
 546
 547     /* Allocate thread structure */
 548     thread = (ithread *)PerlMemShared_malloc(sizeof(ithread));
 549     if (!thread) {
 550         MUTEX_UNLOCK(&create_destruct_mutex);
 551         PerlLIO_write(PerlIO_fileno(Perl_error_log), PL_no_mem, strlen(PL_no_mem));
 552         my_exit(1);
 553     }
 554     Zero(thread, 1, ithread);
 555
 556     /* Add to threads list */
 557     thread->next = &main_thread;
 558     thread->prev = main_thread.prev;
 559     main_thread.prev = thread;
 560     thread->prev->next = thread;
 561
 562     /* Set count to 1 immediately in case thread exits before
 563      * we return to caller!
 564      */
 565     thread->count = 1;
 566
 567     /* Block new thread until ->create() call finishes */
 568     MUTEX_INIT(&thread->mutex);
 569     MUTEX_LOCK(&thread->mutex);
 570
 571     thread->tid = tid_counter++;
 572     thread->stack_size = good_stack_size(aTHX_ stack_size);
 573     thread->gimme = gimme;
 574     thread->state = exit_opt;
 575
 576     /* "Clone" our interpreter into the thread's interpreter.
 577      * This gives thread access to "static data" and code.
 578      */
 579     PerlIO_flush((PerlIO *)NULL);
 580     S_ithread_set(aTHX_ thread);
 581
 582     SAVEBOOL(PL_srand_called); /* Save this so it becomes the correct value */
 583     PL_srand_called = FALSE;   /* Set it to false so we can detect if it gets
 584                                   set during the clone */
 585
 586 #ifdef WIN32
 587     thread->interp = perl_clone(aTHX, CLONEf_KEEP_PTR_TABLE | CLONEf_CLONE_HOST);
 588 #else
 589     thread->interp = perl_clone(aTHX, CLONEf_KEEP_PTR_TABLE);
 590 #endif
 591
 592     /* perl_clone() leaves us in new interpreter's context.  As it is tricky
 593      * to spot an implicit aTHX, create a new scope with aTHX matching the
 594      * context for the duration of our work for new interpreter.
 595      */
 596     {
 597         dTHXa(thread->interp);
 598
 599         MY_CXT_CLONE;
 600
 601         /* Here we remove END blocks since they should only run in the thread
 602          * they are created
 603          */
 604         SvREFCNT_dec(PL_endav);
 605         PL_endav = newAV();
 606
 607         if (SvPOK(init_function)) {
 608             thread->init_function = newSV(0);
 609             sv_copypv(thread->init_function, init_function);
 610         } else {
 611             clone_param.flags = 0;
 612             thread->init_function = sv_dup(init_function, &clone_param);
 613             if (SvREFCNT(thread->init_function) == 0) {
 614                 SvREFCNT_inc_void(thread->init_function);
 615             }
 616         }
 617
 618         thread->params = sv_dup(params, &clone_param);
 619         SvREFCNT_inc_void(thread->params);
 620
 621         /* The code below checks that anything living on the tmps stack and
 622          * has been cloned (so it lives in the ptr_table) has a refcount
 623          * higher than 0.
 624          *
 625          * If the refcount is 0 it means that a something on the stack/context
 626          * was holding a reference to it and since we init_stacks() in
 627          * perl_clone that won't get cleaned and we will get a leaked scalar.
 628          * The reason it was cloned was that it lived on the @_ stack.
 629          *
 630          * Example of this can be found in bugreport 15837 where calls in the
 631          * parameter list end up as a temp.
 632          *
 633          * One could argue that this fix should be in perl_clone.
 634          */
 635         while (tmps_ix > 0) {
 636             SV* sv = (SV*)ptr_table_fetch(PL_ptr_table, tmps_tmp[tmps_ix]);
 637             tmps_ix--;
 638             if (sv && SvREFCNT(sv) == 0) {
 639                 SvREFCNT_inc_void(sv);
 640                 SvREFCNT_dec(sv);
 641             }
 642         }
 643
 644         SvTEMP_off(thread->init_function);
 645         ptr_table_free(PL_ptr_table);
 646         PL_ptr_table = NULL;
 647         PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
 648     }
 649     S_ithread_set(aTHX_ current_thread);
 650     PERL_SET_CONTEXT(aTHX);
 651
 652     /* Create/start the thread */
 653 #ifdef WIN32
 654     thread->handle = CreateThread(NULL,
 655                                   (DWORD)thread->stack_size,
 656                                   S_ithread_run,
 657                                   (LPVOID)thread,
 658                                   STACK_SIZE_PARAM_IS_A_RESERVATION,
 659                                   &thread->thr);
 660 #else
 661     {
 662         static pthread_attr_t attr;
 663         static int attr_inited = 0;
 664         static int attr_joinable = PTHREAD_CREATE_JOINABLE;
 665         if (! attr_inited) {
 666             pthread_attr_init(&attr);
 667             attr_inited = 1;
 668         }
 669
 670 #  ifdef PTHREAD_ATTR_SETDETACHSTATE
 671         /* Threads start out joinable */
 672         PTHREAD_ATTR_SETDETACHSTATE(&attr, attr_joinable);
 673 #  endif
 674
 675 #  ifdef _POSIX_THREAD_ATTR_STACKSIZE
 676         /* Set thread's stack size */
 677         if (thread->stack_size > 0) {
 678             rc_stack_size = pthread_attr_setstacksize(&attr, (size_t)thread->stack_size);
 679         }
 680 #  endif
 681
 682         /* Create the thread */
 683         if (! rc_stack_size) {
 684 #  ifdef OLD_PTHREADS_API
 685             rc_thread_create = pthread_create(&thread->thr,
 686                                               attr,
 687                                               S_ithread_run,
 688                                               (void *)thread);
 689 #  else
 690 #    if defined(HAS_PTHREAD_ATTR_SETSCOPE) && defined(PTHREAD_SCOPE_SYSTEM)
 691             pthread_attr_setscope(&attr, PTHREAD_SCOPE_SYSTEM);
 692 #    endif
 693             rc_thread_create = pthread_create(&thread->thr,
 694                                               &attr,
 695                                               S_ithread_run,
 696                                               (void *)thread);
 697 #  endif
 698         }
 699
 700 #  ifdef _POSIX_THREAD_ATTR_STACKSIZE
 701         /* Try to get thread's actual stack size */
 702         {
 703             size_t stacksize;
 704 #ifdef HPUX1020
 705             stacksize = pthread_attr_getstacksize(attr);
 706 #else
 707             if (! pthread_attr_getstacksize(&attr, &stacksize))
 708 #endif
 709                 if (stacksize > 0) {
 710                     thread->stack_size = (IV)stacksize;
 711                 }
 712         }
 713 #  endif
 714     }
 715 #endif
 716
 717     /* Check for errors */
 718 #ifdef WIN32
 719     if (thread->handle == NULL) {
 720 #else
 721     if (rc_stack_size || rc_thread_create) {
 722 #endif
 723         /* Must unlock mutex for destruct call */
 724         MUTEX_UNLOCK(&create_destruct_mutex);
 725         sv_2mortal(params);
 726         S_ithread_destruct(aTHX_ thread);
 727 #ifndef WIN32
 728         if (ckWARN_d(WARN_THREADS)) {
 729             if (rc_stack_size)
 730                 Perl_warn(aTHX_ "Thread creation failed: pthread_attr_setstacksize(%" IVdf ") returned %d", thread->stack_size, rc_stack_size);
 731             else
 732                 Perl_warn(aTHX_ "Thread creation failed: pthread_create returned %d", rc_thread_create);
 733         }
 734 #endif
 735         return (NULL);
 736     }
 737
 738     running_threads++;
 739     sv_2mortal(params);
 740     return (thread);
 741 }
 742
 743 #endif /* USE_ITHREADS */
 744
 745
 746 MODULE = threads    PACKAGE = threads    PREFIX = ithread_
 747 PROTOTYPES: DISABLE
 748
 749 #ifdef USE_ITHREADS
 750
 751 void
 752 ithread_create(...)
 753     PREINIT:
 754         char *classname;
 755         ithread *thread;
 756         SV *function_to_call;
 757         AV *params;
 758         HV *specs;
 759         IV stack_size;
 760         int context;
 761         int exit_opt;
 762         SV *thread_exit_only;
 763         char *str;
 764         int idx;
 765         int ii;
 766     CODE:
 767         if ((items >= 2) && SvROK(ST(1)) && SvTYPE(SvRV(ST(1)))==SVt_PVHV) {
 768             if (--items < 2)
 769                 Perl_croak(aTHX_ "Usage: threads->create(\\%specs, function, ...)");
 770             specs = (HV*)SvRV(ST(1));
 771             idx = 1;
 772         } else {
 773             if (items < 2)
 774                 Perl_croak(aTHX_ "Usage: threads->create(function, ...)");
 775             specs = NULL;
 776             idx = 0;
 777         }
 778
 779         if (sv_isobject(ST(0))) {
 780             /* $thr->create() */
 781             classname = HvNAME(SvSTASH(SvRV(ST(0))));
 782             thread = INT2PTR(ithread *, SvIV(SvRV(ST(0))));
 783             stack_size = thread->stack_size;
 784             exit_opt = thread->state & PERL_ITHR_THREAD_EXIT_ONLY;
 785         } else {
 786             /* threads->create() */
 787             classname = (char *)SvPV_nolen(ST(0));
 788             stack_size = default_stack_size;
 789             thread_exit_only = get_sv("threads::thread_exit_only", TRUE);
 790             exit_opt = (SvTRUE(thread_exit_only))
 791                                     ? PERL_ITHR_THREAD_EXIT_ONLY : 0;
 792         }
 793
 794         function_to_call = ST(idx+1);
 795
 796         context = -1;
 797         if (specs) {
 798             /* stack_size */
 799             if (hv_exists(specs, "stack", 5)) {
 800                 stack_size = SvIV(*hv_fetch(specs, "stack", 5, 0));
 801             } else if (hv_exists(specs, "stacksize", 9)) {
 802                 stack_size = SvIV(*hv_fetch(specs, "stacksize", 9, 0));
 803             } else if (hv_exists(specs, "stack_size", 10)) {
 804                 stack_size = SvIV(*hv_fetch(specs, "stack_size", 10, 0));
 805             }
 806
 807             /* context */
 808             if (hv_exists(specs, "context", 7)) {
 809                 str = (char *)SvPV_nolen(*hv_fetch(specs, "context", 7, 0));
 810                 switch (*str) {
 811                     case 'a':
 812                     case 'A':
 813                         context = G_ARRAY;
 814                         break;
 815                     case 's':
 816                     case 'S':
 817                         context = G_SCALAR;
 818                         break;
 819                     case 'v':
 820                     case 'V':
 821                         context = G_VOID;
 822                         break;
 823                     default:
 824                         Perl_croak(aTHX_ "Invalid context: %s", str);
 825                 }
 826             } else if (hv_exists(specs, "array", 5)) {
 827                 if (SvTRUE(*hv_fetch(specs, "array", 5, 0))) {
 828                     context = G_ARRAY;
 829                 }
 830             } else if (hv_exists(specs, "scalar", 6)) {
 831                 if (SvTRUE(*hv_fetch(specs, "scalar", 6, 0))) {
 832                     context = G_SCALAR;
 833                 }
 834             } else if (hv_exists(specs, "void", 4)) {
 835                 if (SvTRUE(*hv_fetch(specs, "void", 4, 0))) {
 836                     context = G_VOID;
 837                 }
 838             }
 839
 840             /* exit => thread_only */
 841             if (hv_exists(specs, "exit", 4)) {
 842                 str = (char *)SvPV_nolen(*hv_fetch(specs, "exit", 4, 0));
 843                 exit_opt = (*str == 't' || *str == 'T')
 844                                     ? PERL_ITHR_THREAD_EXIT_ONLY : 0;
 845             }
 846         }
 847         if (context == -1) {
 848             context = GIMME_V;  /* Implicit context */
 849         } else {
 850             context |= (GIMME_V & (~(G_ARRAY|G_SCALAR|G_VOID)));
 851         }
 852
 853         /* Function args */
 854         params = newAV();
 855         if (items > 2) {
 856             for (ii=2; ii < items ; ii++) {
 857                 av_push(params, SvREFCNT_inc(ST(idx+ii)));
 858             }
 859         }
 860
 861         /* Create thread */
 862         MUTEX_LOCK(&create_destruct_mutex);
 863         thread = S_ithread_create(aTHX_ function_to_call,
 864                                         stack_size,
 865                                         context,
 866                                         exit_opt,
 867                                         newRV_noinc((SV*)params));
 868         if (! thread) {
 869             XSRETURN_UNDEF;     /* Mutex already unlocked */
 870         }
 871         ST(0) = sv_2mortal(ithread_to_SV(aTHX_ Nullsv, thread, classname, FALSE));
 872
 873         /* Let thread run */
 874         MUTEX_UNLOCK(&thread->mutex);
 875         MUTEX_UNLOCK(&create_destruct_mutex);
 876
 877         /* XSRETURN(1); - implied */
 878
 879
 880 void
 881 ithread_list(...)
 882     PREINIT:
 883         char *classname;
 884         ithread *thread;
 885         int list_context;
 886         IV count = 0;
 887         int want_running;
 888     PPCODE:
 889         /* Class method only */
 890         if (SvROK(ST(0)))
 891             Perl_croak(aTHX_ "Usage: threads->list(...)");
 892         classname = (char *)SvPV_nolen(ST(0));
 893
 894         /* Calling context */
 895         list_context = (GIMME_V == G_ARRAY);
 896
 897         /* Running or joinable parameter */
 898         if (items > 1) {
 899             want_running = SvTRUE(ST(1));
 900         }
 901
 902         /* Walk through threads list */
 903         MUTEX_LOCK(&create_destruct_mutex);
 904         for (thread = main_thread.next;
 905              thread != &main_thread;
 906              thread = thread->next)
 907         {
 908             /* Ignore detached or joined threads */
 909             if (thread->state & (PERL_ITHR_DETACHED|PERL_ITHR_JOINED)) {
 910                 continue;
 911             }
 912
 913             /* Filter per parameter */
 914             if (items > 1) {
 915                 if (want_running) {
 916                     if (thread->state & PERL_ITHR_FINISHED) {
 917                         continue;   /* Not running */
 918                     }
 919                 } else {
 920                     if (! (thread->state & PERL_ITHR_FINISHED)) {
 921                         continue;   /* Still running - not joinable yet */
 922                     }
 923                 }
 924             }
 925
 926             /* Push object on stack if list context */
 927             if (list_context) {
 928                 XPUSHs(sv_2mortal(ithread_to_SV(aTHX_ Nullsv, thread, classname, TRUE)));
 929             }
 930             count++;
 931         }
 932         MUTEX_UNLOCK(&create_destruct_mutex);
 933         /* If scalar context, send back count */
 934         if (! list_context) {
 935             XSRETURN_IV(count);
 936         }
 937
 938
 939 void
 940 ithread_self(...)
 941     PREINIT:
 942         char *classname;
 943         ithread *thread;
 944     CODE:
 945         /* Class method only */
 946         if (SvROK(ST(0)))
 947             Perl_croak(aTHX_ "Usage: threads->self()");
 948         classname = (char *)SvPV_nolen(ST(0));
 949
 950         thread = S_ithread_get(aTHX);
 951
 952         ST(0) = sv_2mortal(ithread_to_SV(aTHX_ Nullsv, thread, classname, TRUE));
 953         /* XSRETURN(1); - implied */
 954
 955
 956 void
 957 ithread_tid(...)
 958     PREINIT:
 959         ithread *thread;
 960     CODE:
 961         thread = SV_to_ithread(aTHX_ ST(0));
 962         XST_mUV(0, thread->tid);
 963         /* XSRETURN(1); - implied */
 964
 965
 966 void
 967 ithread_join(...)
 968     PREINIT:
 969         ithread *thread;
 970         int join_err;
 971         AV *params;
 972         int len;
 973         int ii;
 974 #ifdef WIN32
 975         DWORD waitcode;
 976 #else
 977         void *retval;
 978 #endif
 979     PPCODE:
 980         /* Object method only */
 981         if (! sv_isobject(ST(0)))
 982             Perl_croak(aTHX_ "Usage: $thr->join()");
 983
 984         /* Check if the thread is joinable */
 985         thread = SV_to_ithread(aTHX_ ST(0));
 986         join_err = (thread->state & (PERL_ITHR_DETACHED|PERL_ITHR_JOINED));
 987         if (join_err) {
 988             if (join_err & PERL_ITHR_DETACHED) {
 989                 Perl_croak(aTHX_ "Cannot join a detached thread");
 990             } else {
 991                 Perl_croak(aTHX_ "Thread already joined");
 992             }
 993         }
 994
 995         /* Join the thread */
 996 #ifdef WIN32
 997         waitcode = WaitForSingleObject(thread->handle, INFINITE);
 998 #else
 999         pthread_join(thread->thr, &retval);
1000 #endif
1001
1002         MUTEX_LOCK(&thread->mutex);
1003         /* Mark as joined */
1004         thread->state |= PERL_ITHR_JOINED;
1005
1006         /* Get the return value from the call_sv */
1007         {
1008             AV *params_copy;
1009             PerlInterpreter *other_perl;
1010             CLONE_PARAMS clone_params;
1011             ithread *current_thread;
1012
1013             params_copy = (AV *)SvRV(thread->params);
1014             other_perl = thread->interp;
1015             clone_params.stashes = newAV();
1016             clone_params.flags = CLONEf_JOIN_IN;
1017             PL_ptr_table = ptr_table_new();
1018             current_thread = S_ithread_get(aTHX);
1019             S_ithread_set(aTHX_ thread);
1020             /* Ensure 'meaningful' addresses retain their meaning */
1021             ptr_table_store(PL_ptr_table, &other_perl->Isv_undef, &PL_sv_undef);
1022             ptr_table_store(PL_ptr_table, &other_perl->Isv_no, &PL_sv_no);
1023             ptr_table_store(PL_ptr_table, &other_perl->Isv_yes, &PL_sv_yes);
1024             params = (AV *)sv_dup((SV*)params_copy, &clone_params);
1025             S_ithread_set(aTHX_ current_thread);
1026             SvREFCNT_dec(clone_params.stashes);
1027             SvREFCNT_inc_void(params);
1028             ptr_table_free(PL_ptr_table);
1029             PL_ptr_table = NULL;
1030         }
1031
1032         /* We are finished with the thread */
1033         S_ithread_clear(aTHX_ thread);
1034         MUTEX_UNLOCK(&thread->mutex);
1035
1036         MUTEX_LOCK(&create_destruct_mutex);
1037         if (! (thread->state & PERL_ITHR_DETACHED)) {
1038             joinable_threads--;
1039         }
1040         MUTEX_UNLOCK(&create_destruct_mutex);
1041
1042         /* If no return values, then just return */
1043         if (! params) {
1044             XSRETURN_UNDEF;
1045         }
1046
1047         /* Put return values on stack */
1048         len = (int)AvFILL(params);
1049         for (ii=0; ii <= len; ii++) {
1050             SV* param = av_shift(params);
1051             XPUSHs(sv_2mortal(param));
1052         }
1053
1054         /* Free return value array */
1055         SvREFCNT_dec(params);
1056
1057
1058 void
1059 ithread_yield(...)
1060     CODE:
1061         YIELD;
1062
1063
1064 void
1065 ithread_detach(...)
1066     PREINIT:
1067         ithread *thread;
1068         int detach_err;
1069         int cleanup;
1070     CODE:
1071         /* Check if the thread is detachable */
1072         thread = SV_to_ithread(aTHX_ ST(0));
1073         if ((detach_err = (thread->state & (PERL_ITHR_DETACHED|PERL_ITHR_JOINED)))) {
1074             if (detach_err & PERL_ITHR_DETACHED) {
1075                 Perl_croak(aTHX_ "Thread already detached");
1076             } else {
1077                 Perl_croak(aTHX_ "Cannot detach a joined thread");
1078             }
1079         }
1080
1081         /* Detach the thread */
1082         MUTEX_LOCK(&create_destruct_mutex);
1083         MUTEX_LOCK(&thread->mutex);
1084         thread->state |= PERL_ITHR_DETACHED;
1085 #ifdef WIN32
1086         /* Windows has no 'detach thread' function */
1087 #else
1088         PERL_THREAD_DETACH(thread->thr);
1089 #endif
1090         /* Cleanup if finished */
1091         cleanup = (thread->state & PERL_ITHR_FINISHED);
1092         MUTEX_UNLOCK(&thread->mutex);
1093
1094         if (cleanup) {
1095             joinable_threads--;
1096         } else {
1097             running_threads--;
1098             detached_threads++;
1099         }
1100         MUTEX_UNLOCK(&create_destruct_mutex);
1101
1102         if (cleanup) {
1103             S_ithread_destruct(aTHX_ thread);
1104         }
1105
1106
1107 void
1108 ithread_kill(...)
1109     PREINIT:
1110         ithread *thread;
1111         char *sig_name;
1112         IV signal;
1113     CODE:
1114         /* Must have safe signals */
1115         if (PL_signals & PERL_SIGNALS_UNSAFE_FLAG)
1116             Perl_croak(aTHX_ "Cannot signal threads without safe signals");
1117
1118         /* Object method only */
1119         if (! sv_isobject(ST(0)))
1120             Perl_croak(aTHX_ "Usage: $thr->kill('SIG...')");
1121
1122         /* Get signal */
1123         sig_name = SvPV_nolen(ST(1));
1124         if (isALPHA(*sig_name)) {
1125             if (*sig_name == 'S' && sig_name[1] == 'I' && sig_name[2] == 'G')
1126                 sig_name += 3;
1127             if ((signal = whichsig(sig_name)) < 0)
1128                 Perl_croak(aTHX_ "Unrecognized signal name: %s", sig_name);
1129         } else
1130             signal = SvIV(ST(1));
1131
1132         /* Set the signal for the thread */
1133         thread = SV_to_ithread(aTHX_ ST(0));
1134         MUTEX_LOCK(&thread->mutex);
1135         if (thread->interp) {
1136             dTHXa(thread->interp);
1137             PL_psig_pend[signal]++;
1138             PL_sig_pending = 1;
1139         }
1140         MUTEX_UNLOCK(&thread->mutex);
1141
1142         /* Return the thread to allow for method chaining */
1143         ST(0) = ST(0);
1144         /* XSRETURN(1); - implied */
1145
1146
1147 void
1148 ithread_DESTROY(...)
1149     CODE:
1150         sv_unmagic(SvRV(ST(0)), PERL_MAGIC_shared_scalar);
1151
1152
1153 void
1154 ithread_equal(...)
1155     PREINIT:
1156         int are_equal = 0;
1157     CODE:
1158         /* Compares TIDs to determine thread equality */
1159         if (sv_isobject(ST(0)) && sv_isobject(ST(1))) {
1160             ithread *thr1 = INT2PTR(ithread *, SvIV(SvRV(ST(0))));
1161             ithread *thr2 = INT2PTR(ithread *, SvIV(SvRV(ST(1))));
1162             are_equal = (thr1->tid == thr2->tid);
1163         }
1164         if (are_equal) {
1165             XST_mYES(0);
1166         } else {
1167             /* Return 0 on false for backward compatibility */
1168             XST_mIV(0, 0);
1169         }
1170         /* XSRETURN(1); - implied */
1171
1172
1173 void
1174 ithread_object(...)
1175     PREINIT:
1176         char *classname;
1177         UV tid;
1178         ithread *thread;
1179         int have_obj = 0;
1180     CODE:
1181         /* Class method only */
1182         if (SvROK(ST(0)))
1183             Perl_croak(aTHX_ "Usage: threads->object($tid)");
1184         classname = (char *)SvPV_nolen(ST(0));
1185
1186         if ((items < 2) || ! SvOK(ST(1))) {
1187             XSRETURN_UNDEF;
1188         }
1189
1190         /* threads->object($tid) */
1191         tid = SvUV(ST(1));
1192
1193         /* Walk through threads list */
1194         MUTEX_LOCK(&create_destruct_mutex);
1195         for (thread = main_thread.next;
1196              thread != &main_thread;
1197              thread = thread->next)
1198         {
1199             /* Look for TID */
1200             if (thread->tid == tid) {
1201                 /* Ignore if detached or joined */
1202                 if (! (thread->state & (PERL_ITHR_DETACHED|PERL_ITHR_JOINED))) {
1203                     /* Put object on stack */
1204                     ST(0) = sv_2mortal(ithread_to_SV(aTHX_ Nullsv, thread, classname, TRUE));
1205                     have_obj = 1;
1206                 }
1207                 break;
1208             }
1209         }
1210         MUTEX_UNLOCK(&create_destruct_mutex);
1211
1212         if (! have_obj) {
1213             XSRETURN_UNDEF;
1214         }
1215         /* XSRETURN(1); - implied */
1216
1217
1218 void
1219 ithread__handle(...);
1220     PREINIT:
1221         ithread *thread;
1222     CODE:
1223         thread = SV_to_ithread(aTHX_ ST(0));
1224 #ifdef WIN32
1225         XST_mUV(0, PTR2UV(&thread->handle));
1226 #else
1227         XST_mUV(0, PTR2UV(&thread->thr));
1228 #endif
1229         /* XSRETURN(1); - implied */
1230
1231
1232 void
1233 ithread_get_stack_size(...)
1234     PREINIT:
1235         IV stack_size;
1236     CODE:
1237         if (sv_isobject(ST(0))) {
1238             /* $thr->get_stack_size() */
1239             ithread *thread = INT2PTR(ithread *, SvIV(SvRV(ST(0))));
1240             stack_size = thread->stack_size;
1241         } else {
1242             /* threads->get_stack_size() */
1243             stack_size = default_stack_size;
1244         }
1245         XST_mIV(0, stack_size);
1246         /* XSRETURN(1); - implied */
1247
1248
1249 void
1250 ithread_set_stack_size(...)
1251     PREINIT:
1252         IV old_size;
1253     CODE:
1254         if (items != 2)
1255             Perl_croak(aTHX_ "Usage: threads->set_stack_size($size)");
1256         if (sv_isobject(ST(0)))
1257             Perl_croak(aTHX_ "Cannot change stack size of an existing thread");
1258
1259         old_size = default_stack_size;
1260         default_stack_size = good_stack_size(aTHX_ SvIV(ST(1)));
1261         XST_mIV(0, old_size);
1262         /* XSRETURN(1); - implied */
1263
1264
1265 void
1266 ithread_is_running(...)
1267     PREINIT:
1268         ithread *thread;
1269     CODE:
1270         /* Object method only */
1271         if (! sv_isobject(ST(0)))
1272             Perl_croak(aTHX_ "Usage: $thr->is_running()");
1273
1274         thread = INT2PTR(ithread *, SvIV(SvRV(ST(0))));
1275         ST(0) = (thread->state & PERL_ITHR_FINISHED) ? &PL_sv_no : &PL_sv_yes;
1276         /* XSRETURN(1); - implied */
1277
1278
1279 void
1280 ithread_is_detached(...)
1281     PREINIT:
1282         ithread *thread;
1283     CODE:
1284         thread = SV_to_ithread(aTHX_ ST(0));
1285         ST(0) = (thread->state & PERL_ITHR_DETACHED) ? &PL_sv_yes : &PL_sv_no;
1286         /* XSRETURN(1); - implied */
1287
1288
1289 void
1290 ithread_is_joinable(...)
1291     PREINIT:
1292         ithread *thread;
1293     CODE:
1294         /* Object method only */
1295         if (! sv_isobject(ST(0)))
1296             Perl_croak(aTHX_ "Usage: $thr->is_joinable()");
1297
1298         thread = INT2PTR(ithread *, SvIV(SvRV(ST(0))));
1299         MUTEX_LOCK(&thread->mutex);
1300         ST(0) = ((thread->state & PERL_ITHR_FINISHED) &&
1301                  ! (thread->state & (PERL_ITHR_DETACHED|PERL_ITHR_JOINED)))
1302             ? &PL_sv_yes : &PL_sv_no;
1303         MUTEX_UNLOCK(&thread->mutex);
1304         /* XSRETURN(1); - implied */
1305
1306
1307 void
1308 ithread_wantarray(...)
1309     PREINIT:
1310         ithread *thread;
1311     CODE:
1312         thread = SV_to_ithread(aTHX_ ST(0));
1313         ST(0) = (thread->gimme & G_ARRAY) ? &PL_sv_yes :
1314                 (thread->gimme & G_VOID)  ? &PL_sv_undef
1315                            /* G_SCALAR */ : &PL_sv_no;
1316         /* XSRETURN(1); - implied */
1317
1318
1319 void
1320 ithread_set_thread_exit_only(...)
1321     PREINIT:
1322         ithread *thread;
1323     CODE:
1324         if (items != 2)
1325             Perl_croak(aTHX_ "Usage: ->set_thread_exit_only(boolean)");
1326         thread = SV_to_ithread(aTHX_ ST(0));
1327         MUTEX_LOCK(&thread->mutex);
1328         if (SvTRUE(ST(1))) {
1329             thread->state |= PERL_ITHR_THREAD_EXIT_ONLY;
1330         } else {
1331             thread->state &= ~PERL_ITHR_THREAD_EXIT_ONLY;
1332         }
1333         MUTEX_UNLOCK(&thread->mutex);
1334
1335 #endif /* USE_ITHREADS */
1336
1337
1338 BOOT:
1339 {
1340 #ifdef USE_ITHREADS
1341     MY_CXT_INIT;
1342
1343     PL_perl_destruct_level = 2;
1344     MUTEX_INIT(&create_destruct_mutex);
1345     MUTEX_LOCK(&create_destruct_mutex);
1346
1347     PL_threadhook = &Perl_ithread_hook;
1348
1349     /* The 'main' thread is thread 0.
1350      * It is detached (unjoinable) and immortal.
1351      */
1352     Zero(&main_thread, 1, ithread);         /* Thread 0 */
1353
1354     MUTEX_INIT(&main_thread.mutex);
1355
1356     /* Head of the threads list */
1357     main_thread.next = &main_thread;
1358     main_thread.prev = &main_thread;
1359
1360     main_thread.count = 1;                  /* Immortal */
1361
1362     main_thread.interp = aTHX;
1363     main_thread.state = PERL_ITHR_DETACHED; /* Detached */
1364     main_thread.stack_size = default_stack_size;
1365 #  ifdef WIN32
1366     main_thread.thr = GetCurrentThreadId();
1367 #  else
1368     main_thread.thr = pthread_self();
1369 #  endif
1370
1371     S_ithread_set(aTHX_ &main_thread);
1372     MUTEX_UNLOCK(&create_destruct_mutex);
1373 #endif /* USE_ITHREADS */
1374 }