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