ext/threads/threads.xs

   1 #define PERL_NO_GET_CONTEXT
   2 #include "EXTERN.h"
   3 #include "perl.h"
   4 #include "XSUB.h"
   5
   6 #ifdef USE_ITHREADS
   7
   8 #ifdef WIN32
   9 #include <windows.h>
  10 #include <win32thread.h>
  11 #define PERL_THREAD_SETSPECIFIC(k,v) TlsSetValue(k,v)
  12 #define PERL_THREAD_GETSPECIFIC(k,v) v = TlsGetValue(k)
  13 #define PERL_THREAD_ALLOC_SPECIFIC(k) \
  14 STMT_START {\
  15   if((k = TlsAlloc()) == TLS_OUT_OF_INDEXES) {\
  16     PerlIO_printf(PerlIO_stderr(),"panic threads.h: TlsAlloc");\
  17     exit(1);\
  18   }\
  19 } STMT_END
  20 #else
  21 #include <pthread.h>
  22 #include <thread.h>
  23
  24 #define PERL_THREAD_SETSPECIFIC(k,v) pthread_setspecific(k,v)
  25 #ifdef OLD_PTHREADS_API
  26 #define PERL_THREAD_DETACH(t) pthread_detach(&(t))
  27 #define PERL_THREAD_GETSPECIFIC(k,v) pthread_getspecific(k,&v)
  28 #define PERL_THREAD_ALLOC_SPECIFIC(k) STMT_START {\
  29   if(pthread_keycreate(&(k),0)) {\
  30     PerlIO_printf(PerlIO_stderr(), "panic threads.h: pthread_key_create");\
  31     exit(1);\
  32   }\
  33 } STMT_END
  34 #else
  35 #define PERL_THREAD_DETACH(t) pthread_detach((t))
  36 #define PERL_THREAD_GETSPECIFIC(k,v) v = pthread_getspecific(k)
  37 #define PERL_THREAD_ALLOC_SPECIFIC(k) STMT_START {\
  38   if(pthread_key_create(&(k),0)) {\
  39     PerlIO_printf(PerlIO_stderr(), "panic threads.h: pthread_key_create");\
  40     exit(1);\
  41   }\
  42 } STMT_END
  43 #endif
  44 #endif
  45
  46 /* Values for 'state' member */
  47 #define PERL_ITHR_JOINABLE              0
  48 #define PERL_ITHR_DETACHED              1
  49 #define PERL_ITHR_FINISHED              4
  50 #define PERL_ITHR_JOINED                2
  51
  52 typedef struct ithread_s {
  53     struct ithread_s *next;     /* next thread in the list */
  54     struct ithread_s *prev;     /* prev thread in the list */
  55     PerlInterpreter *interp;    /* The threads interpreter */
  56     I32 tid;                    /* threads module's thread id */
  57     perl_mutex mutex;           /* mutex for updating things in this struct */
  58     I32 count;                  /* how many SVs have a reference to us */
  59     signed char state;          /* are we detached ? */
  60     int gimme;                  /* Context of create */
  61     SV* init_function;          /* Code to run */
  62     SV* params;                 /* args to pass function */
  63 #ifdef WIN32
  64         DWORD   thr;            /* OS's idea if thread id */
  65         HANDLE handle;          /* OS's waitable handle */
  66 #else
  67         pthread_t thr;          /* OS's handle for the thread */
  68 #endif
  69 } ithread;
  70
  71 ithread *threads;
  72
  73 /* Macros to supply the aTHX_ in an embed.h like manner */
  74 #define ithread_join(thread)            Perl_ithread_join(aTHX_ thread)
  75 #define ithread_DESTROY(thread)         Perl_ithread_DESTROY(aTHX_ thread)
  76 #define ithread_CLONE(thread)           Perl_ithread_CLONE(aTHX_ thread)
  77 #define ithread_detach(thread)          Perl_ithread_detach(aTHX_ thread)
  78 #define ithread_tid(thread)             ((thread)->tid)
  79 #define ithread_yield(thread)           (YIELD);
  80
  81 static perl_mutex create_destruct_mutex;  /* protects the creation and destruction of threads*/
  82
  83 I32 tid_counter = 0;
  84 I32 known_threads = 0;
  85 I32 active_threads = 0;
  86 perl_key self_key;
  87
  88 /*
  89  *  Clear up after thread is done with
  90  */
  91 void
  92 Perl_ithread_destruct (pTHX_ ithread* thread, const char *why)
  93 {
  94         MUTEX_LOCK(&thread->mutex);
  95         if (!thread->next) {
  96             Perl_croak(aTHX_ "panic: destruct destroyed thread %p (%s)",thread, why);
  97         }
  98         if (thread->count != 0) {
  99                 MUTEX_UNLOCK(&thread->mutex);
 100                 return;
 101         }
 102         MUTEX_LOCK(&create_destruct_mutex);
 103         /* Remove from circular list of threads */
 104         if (thread->next == thread) {
 105             /* last one should never get here ? */
 106             threads = NULL;
 107         }
 108         else {
 109             thread->next->prev = thread->prev;
 110             thread->prev->next = thread->next;
 111             if (threads == thread) {
 112                 threads = thread->next;
 113             }
 114             thread->next = NULL;
 115             thread->prev = NULL;
 116         }
 117         known_threads--;
 118         assert( known_threads >= 0 );
 119 #if 0
 120         Perl_warn(aTHX_ "destruct %d @ %p by %p now %d",
 121                   thread->tid,thread->interp,aTHX, known_threads);
 122 #endif
 123         MUTEX_UNLOCK(&create_destruct_mutex);
 124         /* Thread is now disowned */
 125
 126         if(thread->interp) {
 127             dTHXa(thread->interp);
 128             ithread*        current_thread;
 129             PERL_SET_CONTEXT(thread->interp);
 130             PERL_THREAD_GETSPECIFIC(self_key,current_thread);
 131             PERL_THREAD_SETSPECIFIC(self_key,thread);
 132             SvREFCNT_dec(thread->params);
 133             thread->params = Nullsv;
 134             perl_destruct(thread->interp);
 135             perl_free(thread->interp);
 136             thread->interp = NULL;
 137             PERL_THREAD_SETSPECIFIC(self_key,current_thread);
 138
 139         }
 140         MUTEX_UNLOCK(&thread->mutex);
 141         MUTEX_DESTROY(&thread->mutex);
 142         PerlMemShared_free(thread);
 143
 144         PERL_SET_CONTEXT(aTHX);
 145 }
 146
 147 int
 148 Perl_ithread_hook(pTHX)
 149 {
 150     int veto_cleanup = 0;
 151     MUTEX_LOCK(&create_destruct_mutex);
 152     if (aTHX == PL_curinterp && active_threads != 1) {
 153         Perl_warn(aTHX_ "A thread exited while %" IVdf " other threads were still running",
 154                                                 (IV)active_threads);
 155         veto_cleanup = 1;
 156     }
 157     MUTEX_UNLOCK(&create_destruct_mutex);
 158     return veto_cleanup;
 159 }
 160
 161 void
 162 Perl_ithread_detach(pTHX_ ithread *thread)
 163 {
 164     MUTEX_LOCK(&thread->mutex);
 165     if (!(thread->state & (PERL_ITHR_DETACHED|PERL_ITHR_JOINED))) {
 166         thread->state |= PERL_ITHR_DETACHED;
 167 #ifdef WIN32
 168         CloseHandle(thread->handle);
 169         thread->handle = 0;
 170 #else
 171         PERL_THREAD_DETACH(thread->thr);
 172 #endif
 173     }
 174     if ((thread->state & PERL_ITHR_FINISHED) &&
 175         (thread->state & PERL_ITHR_DETACHED)) {
 176         MUTEX_UNLOCK(&thread->mutex);
 177         Perl_ithread_destruct(aTHX_ thread, "detach");
 178     }
 179     else {
 180         MUTEX_UNLOCK(&thread->mutex);
 181     }
 182 }
 183
 184 /* MAGIC (in mg.h sense) hooks */
 185
 186 int
 187 ithread_mg_get(pTHX_ SV *sv, MAGIC *mg)
 188 {
 189     ithread *thread = (ithread *) mg->mg_ptr;
 190     SvIVX(sv) = PTR2IV(thread);
 191     SvIOK_on(sv);
 192     return 0;
 193 }
 194
 195 int
 196 ithread_mg_free(pTHX_ SV *sv, MAGIC *mg)
 197 {
 198     ithread *thread = (ithread *) mg->mg_ptr;
 199     MUTEX_LOCK(&thread->mutex);
 200     thread->count--;
 201     if (thread->count == 0) {
 202        if(thread->state & PERL_ITHR_FINISHED &&
 203           (thread->state & PERL_ITHR_DETACHED ||
 204            thread->state & PERL_ITHR_JOINED))
 205        {
 206             MUTEX_UNLOCK(&thread->mutex);
 207             Perl_ithread_destruct(aTHX_ thread, "no reference");
 208        }
 209        else {
 210             MUTEX_UNLOCK(&thread->mutex);
 211        }
 212     }
 213     else {
 214         MUTEX_UNLOCK(&thread->mutex);
 215     }
 216     return 0;
 217 }
 218
 219 int
 220 ithread_mg_dup(pTHX_ MAGIC *mg, CLONE_PARAMS *param)
 221 {
 222     ithread *thread = (ithread *) mg->mg_ptr;
 223     MUTEX_LOCK(&thread->mutex);
 224     thread->count++;
 225     MUTEX_UNLOCK(&thread->mutex);
 226     return 0;
 227 }
 228
 229 MGVTBL ithread_vtbl = {
 230  ithread_mg_get,        /* get */
 231  0,                     /* set */
 232  0,                     /* len */
 233  0,                     /* clear */
 234  ithread_mg_free,       /* free */
 235  0,                     /* copy */
 236  ithread_mg_dup         /* dup */
 237 };
 238
 239
 240 /*
 241  *      Starts executing the thread. Needs to clean up memory a tad better.
 242  *      Passed as the C level function to run in the new thread
 243  */
 244
 245 #ifdef WIN32
 246 THREAD_RET_TYPE
 247 Perl_ithread_run(LPVOID arg) {
 248 #else
 249 void*
 250 Perl_ithread_run(void * arg) {
 251 #endif
 252         ithread* thread = (ithread*) arg;
 253         dTHXa(thread->interp);
 254         PERL_SET_CONTEXT(thread->interp);
 255         PERL_THREAD_SETSPECIFIC(self_key,thread);
 256
 257 #if 0
 258         /* Far from clear messing with ->thr child-side is a good idea */
 259         MUTEX_LOCK(&thread->mutex);
 260 #ifdef WIN32
 261         thread->thr = GetCurrentThreadId();
 262 #else
 263         thread->thr = pthread_self();
 264 #endif
 265         MUTEX_UNLOCK(&thread->mutex);
 266 #endif
 267
 268         PL_perl_destruct_level = 2;
 269
 270         {
 271                 AV* params = (AV*) SvRV(thread->params);
 272                 I32 len = av_len(params)+1;
 273                 int i;
 274                 dSP;
 275                 ENTER;
 276                 SAVETMPS;
 277                 PUSHMARK(SP);
 278                 for(i = 0; i < len; i++) {
 279                     XPUSHs(av_shift(params));
 280                 }
 281                 PUTBACK;
 282                 len = call_sv(thread->init_function, thread->gimme|G_EVAL);
 283
 284                 SPAGAIN;
 285                 for (i=len-1; i >= 0; i--) {
 286                   SV *sv = POPs;
 287                   av_store(params, i, SvREFCNT_inc(sv));
 288                 }
 289                 if (SvTRUE(ERRSV)) {
 290                     Perl_warn(aTHX_ "thread failed to start: %" SVf, ERRSV);
 291                 }
 292                 FREETMPS;
 293                 LEAVE;
 294                 SvREFCNT_dec(thread->init_function);
 295         }
 296
 297         PerlIO_flush((PerlIO*)NULL);
 298         MUTEX_LOCK(&thread->mutex);
 299         thread->state |= PERL_ITHR_FINISHED;
 300
 301         if (thread->state & PERL_ITHR_DETACHED) {
 302                 MUTEX_UNLOCK(&thread->mutex);
 303                 Perl_ithread_destruct(aTHX_ thread, "detached finish");
 304         } else {
 305                 MUTEX_UNLOCK(&thread->mutex);
 306         }
 307         MUTEX_LOCK(&create_destruct_mutex);
 308         active_threads--;
 309         assert( active_threads >= 0 );
 310         MUTEX_UNLOCK(&create_destruct_mutex);
 311
 312 #ifdef WIN32
 313         return (DWORD)0;
 314 #else
 315         return 0;
 316 #endif
 317 }
 318
 319 SV *
 320 ithread_to_SV(pTHX_ SV *obj, ithread *thread, char *classname, bool inc)
 321 {
 322     SV *sv;
 323     MAGIC *mg;
 324     if (inc) {
 325         MUTEX_LOCK(&thread->mutex);
 326         thread->count++;
 327         MUTEX_UNLOCK(&thread->mutex);
 328     }
 329     if (!obj)
 330      obj = newSV(0);
 331     sv = newSVrv(obj,classname);
 332     sv_setiv(sv,PTR2IV(thread));
 333     mg = sv_magicext(sv,Nullsv,PERL_MAGIC_shared_scalar,&ithread_vtbl,(char *)thread,0);
 334     mg->mg_flags |= MGf_DUP;
 335     SvREADONLY_on(sv);
 336     return obj;
 337 }
 338
 339 ithread *
 340 SV_to_ithread(pTHX_ SV *sv)
 341 {
 342     ithread *thread;
 343     if (SvROK(sv))
 344      {
 345       thread = INT2PTR(ithread*, SvIV(SvRV(sv)));
 346      }
 347     else
 348      {
 349       PERL_THREAD_GETSPECIFIC(self_key,thread);
 350      }
 351     return thread;
 352 }
 353
 354 /*
 355  * iThread->create(); ( aka iThread->new() )
 356  * Called in context of parent thread
 357  */
 358
 359 SV *
 360 Perl_ithread_create(pTHX_ SV *obj, char* classname, SV* init_function, SV* params)
 361 {
 362         ithread*        thread;
 363         CLONE_PARAMS    clone_param;
 364         ithread*        current_thread;
 365         PERL_THREAD_GETSPECIFIC(self_key,current_thread);
 366         MUTEX_LOCK(&create_destruct_mutex);
 367         thread = PerlMemShared_malloc(sizeof(ithread));
 368         Zero(thread,1,ithread);
 369         thread->next = threads;
 370         thread->prev = threads->prev;
 371         threads->prev = thread;
 372         thread->prev->next = thread;
 373         /* Set count to 1 immediately in case thread exits before
 374          * we return to caller !
 375          */
 376         thread->count = 1;
 377         MUTEX_INIT(&thread->mutex);
 378         thread->tid = tid_counter++;
 379         thread->gimme = GIMME_V;
 380
 381         /* "Clone" our interpreter into the thread's interpreter
 382          * This gives thread access to "static data" and code.
 383          */
 384
 385         PerlIO_flush((PerlIO*)NULL);
 386         PERL_THREAD_SETSPECIFIC(self_key,thread);
 387 #ifdef WIN32
 388         thread->interp = perl_clone(aTHX, CLONEf_KEEP_PTR_TABLE | CLONEf_CLONE_HOST);
 389 #else
 390         thread->interp = perl_clone(aTHX, CLONEf_KEEP_PTR_TABLE);
 391 #endif
 392         /* perl_clone leaves us in new interpreter's context.
 393            As it is tricky to spot an implicit aTHX, create a new scope
 394            with aTHX matching the context for the duration of
 395            our work for new interpreter.
 396          */
 397         {
 398             dTHXa(thread->interp);
 399             /* Here we remove END blocks since they should only run
 400                in the thread they are created
 401             */
 402             SvREFCNT_dec(PL_endav);
 403             PL_endav = newAV();
 404             clone_param.flags = 0;
 405             thread->init_function = sv_dup(init_function, &clone_param);
 406             if (SvREFCNT(thread->init_function) == 0) {
 407                 SvREFCNT_inc(thread->init_function);
 408             }
 409
 410             thread->params = sv_dup(params, &clone_param);
 411             SvREFCNT_inc(thread->params);
 412             SvTEMP_off(thread->init_function);
 413             ptr_table_free(PL_ptr_table);
 414             PL_ptr_table = NULL;
 415             PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
 416         }
 417         PERL_THREAD_SETSPECIFIC(self_key,current_thread);
 418         PERL_SET_CONTEXT(aTHX);
 419
 420         /* Start the thread */
 421
 422 #ifdef WIN32
 423
 424         thread->handle = CreateThread(NULL, 0, Perl_ithread_run,
 425                         (LPVOID)thread, 0, &thread->thr);
 426
 427 #else
 428         {
 429           static pthread_attr_t attr;
 430           static int attr_inited = 0;
 431           static int attr_joinable = PTHREAD_CREATE_JOINABLE;
 432           if (!attr_inited) {
 433             attr_inited = 1;
 434             pthread_attr_init(&attr);
 435           }
 436 #  ifdef PTHREAD_ATTR_SETDETACHSTATE
 437             PTHREAD_ATTR_SETDETACHSTATE(&attr, attr_joinable);
 438 #  endif
 439 #  ifdef THREAD_CREATE_NEEDS_STACK
 440             if(pthread_attr_setstacksize(&attr, THREAD_CREATE_NEEDS_STACK))
 441               croak("panic: pthread_attr_setstacksize failed");
 442 #  endif
 443
 444 #ifdef OLD_PTHREADS_API
 445           pthread_create( &thread->thr, attr, Perl_ithread_run, (void *)thread);
 446 #else
 447           pthread_create( &thread->thr, &attr, Perl_ithread_run, (void *)thread);
 448 #endif
 449         }
 450 #endif
 451         known_threads++;
 452         active_threads++;
 453         MUTEX_UNLOCK(&create_destruct_mutex);
 454         sv_2mortal(params);
 455         return ithread_to_SV(aTHX_ obj, thread, classname, FALSE);
 456 }
 457
 458 SV*
 459 Perl_ithread_self (pTHX_ SV *obj, char* Class)
 460 {
 461     ithread *thread;
 462     PERL_THREAD_GETSPECIFIC(self_key,thread);
 463     return ithread_to_SV(aTHX_ obj, thread, Class, TRUE);
 464 }
 465
 466 /*
 467  * Joins the thread this code needs to take the returnvalue from the
 468  * call_sv and send it back
 469  */
 470
 471 void
 472 Perl_ithread_CLONE(pTHX_ SV *obj)
 473 {
 474  if (SvROK(obj))
 475   {
 476    ithread *thread = SV_to_ithread(aTHX_ obj);
 477   }
 478  else
 479   {
 480    Perl_warn(aTHX_ "CLONE %" SVf,obj);
 481   }
 482 }
 483
 484 AV*
 485 Perl_ithread_join(pTHX_ SV *obj)
 486 {
 487     ithread *thread = SV_to_ithread(aTHX_ obj);
 488     MUTEX_LOCK(&thread->mutex);
 489     if (thread->state & PERL_ITHR_DETACHED) {
 490         MUTEX_UNLOCK(&thread->mutex);
 491         Perl_croak(aTHX_ "Cannot join a detached thread");
 492     }
 493     else if (thread->state & PERL_ITHR_JOINED) {
 494         MUTEX_UNLOCK(&thread->mutex);
 495         Perl_croak(aTHX_ "Thread already joined");
 496     }
 497     else {
 498         AV* retparam;
 499 #ifdef WIN32
 500         DWORD waitcode;
 501 #else
 502         void *retval;
 503 #endif
 504         MUTEX_UNLOCK(&thread->mutex);
 505 #ifdef WIN32
 506         waitcode = WaitForSingleObject(thread->handle, INFINITE);
 507 #else
 508         pthread_join(thread->thr,&retval);
 509 #endif
 510         MUTEX_LOCK(&thread->mutex);
 511
 512         /* sv_dup over the args */
 513         {
 514           ithread*        current_thread;
 515           AV* params = (AV*) SvRV(thread->params);
 516           CLONE_PARAMS clone_params;
 517           clone_params.stashes = newAV();
 518           clone_params.flags |= CLONEf_JOIN_IN;
 519           PL_ptr_table = ptr_table_new();
 520           PERL_THREAD_GETSPECIFIC(self_key,current_thread);
 521           PERL_THREAD_SETSPECIFIC(self_key,thread);
 522
 523 #if 0
 524           {
 525             I32 len = av_len(params)+1;
 526             I32 i;
 527             for(i = 0; i < len; i++) {
 528               sv_dump(SvRV(AvARRAY(params)[i]));
 529             }
 530           }
 531 #endif
 532           retparam = (AV*) sv_dup((SV*)params, &clone_params);
 533 #if 0
 534           {
 535             I32 len = av_len(retparam)+1;
 536             I32 i;
 537             for(i = 0; i < len; i++) {
 538                 sv_dump(SvRV(AvARRAY(retparam)[i]));
 539             }
 540           }
 541 #endif
 542           PERL_THREAD_SETSPECIFIC(self_key,current_thread);
 543           SvREFCNT_dec(clone_params.stashes);
 544           SvREFCNT_inc(retparam);
 545           ptr_table_free(PL_ptr_table);
 546           PL_ptr_table = NULL;
 547
 548         }
 549         /* We have finished with it */
 550         thread->state |= PERL_ITHR_JOINED;
 551         MUTEX_UNLOCK(&thread->mutex);
 552         sv_unmagic(SvRV(obj),PERL_MAGIC_shared_scalar);
 553         return retparam;
 554     }
 555     return (AV*)NULL;
 556 }
 557
 558 void
 559 Perl_ithread_DESTROY(pTHX_ SV *sv)
 560 {
 561     ithread *thread = SV_to_ithread(aTHX_ sv);
 562     sv_unmagic(SvRV(sv),PERL_MAGIC_shared_scalar);
 563 }
 564
 565 #endif /* USE_ITHREADS */
 566
 567 MODULE = threads                PACKAGE = threads       PREFIX = ithread_
 568 PROTOTYPES: DISABLE
 569
 570 #ifdef USE_ITHREADS
 571
 572 void
 573 ithread_new (classname, function_to_call, ...)
 574 char *  classname
 575 SV *    function_to_call
 576 CODE:
 577 {
 578     AV* params = newAV();
 579     if (items > 2) {
 580         int i;
 581         for(i = 2; i < items ; i++) {
 582             av_push(params, SvREFCNT_inc(ST(i)));
 583         }
 584     }
 585     ST(0) = sv_2mortal(Perl_ithread_create(aTHX_ Nullsv, classname, function_to_call, newRV_noinc((SV*) params)));
 586     XSRETURN(1);
 587 }
 588
 589 void
 590 ithread_list(char *classname)
 591 PPCODE:
 592 {
 593   ithread *curr_thread;
 594   MUTEX_LOCK(&create_destruct_mutex);
 595   curr_thread = threads;
 596   if(curr_thread->tid != 0)
 597     PUSHs( sv_2mortal(ithread_to_SV(aTHX_ NULL, curr_thread, classname, TRUE)));
 598   while(curr_thread) {
 599     curr_thread = curr_thread->next;
 600     if(curr_thread == threads)
 601       break;
 602     if(curr_thread->state & PERL_ITHR_DETACHED ||
 603        curr_thread->state & PERL_ITHR_JOINED)
 604          continue;
 605      PUSHs( sv_2mortal(ithread_to_SV(aTHX_ NULL, curr_thread, classname, TRUE)));
 606   }
 607   MUTEX_UNLOCK(&create_destruct_mutex);
 608 }
 609
 610
 611 void
 612 ithread_self(char *classname)
 613 CODE:
 614 {
 615         ST(0) = sv_2mortal(Perl_ithread_self(aTHX_ Nullsv,classname));
 616         XSRETURN(1);
 617 }
 618
 619 int
 620 ithread_tid(ithread *thread)
 621
 622 void
 623 ithread_join(SV *obj)
 624 PPCODE:
 625 {
 626   AV* params = Perl_ithread_join(aTHX_ obj);
 627   int i;
 628   I32 len = AvFILL(params);
 629   for (i = 0; i <= len; i++) {
 630     SV* tmp = av_shift(params);
 631     XPUSHs(tmp);
 632     sv_2mortal(tmp);
 633   }
 634   SvREFCNT_dec(params);
 635 }
 636
 637 void
 638 yield(...)
 639 CODE:
 640 {
 641     YIELD;
 642 }
 643
 644
 645 void
 646 ithread_detach(ithread *thread)
 647
 648 void
 649 ithread_DESTROY(SV *thread)
 650
 651 #endif /* USE_ITHREADS */
 652
 653 BOOT:
 654 {
 655 #ifdef USE_ITHREADS
 656         ithread* thread;
 657         PL_perl_destruct_level = 2;
 658         PERL_THREAD_ALLOC_SPECIFIC(self_key);
 659         MUTEX_INIT(&create_destruct_mutex);
 660         MUTEX_LOCK(&create_destruct_mutex);
 661         PL_threadhook = &Perl_ithread_hook;
 662         thread  = PerlMemShared_malloc(sizeof(ithread));
 663         Zero(thread,1,ithread);
 664         PL_perl_destruct_level = 2;
 665         MUTEX_INIT(&thread->mutex);
 666         threads = thread;
 667         thread->next = thread;
 668         thread->prev = thread;
 669         thread->interp = aTHX;
 670         thread->count  = 1;  /* imortal */
 671         thread->tid = tid_counter++;
 672         known_threads++;
 673         active_threads++;
 674         thread->state = 1;
 675 #ifdef WIN32
 676         thread->thr = GetCurrentThreadId();
 677 #else
 678         thread->thr = pthread_self();
 679 #endif
 680
 681         PERL_THREAD_SETSPECIFIC(self_key,thread);
 682         MUTEX_UNLOCK(&create_destruct_mutex);
 683 #endif /* USE_ITHREADS */
 684 }
 685