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