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