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