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 11 #include 12 #else 13 #ifdef OS2 14 typedef perl_os_thread pthread_t; 15 #else 16 #include 17 #endif 18 #include 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 #ifdef WIN32 154 if (thread->handle) 155 CloseHandle(thread->handle); 156 thread->handle = 0; 157 #endif 158 PerlMemShared_free(thread); 159 if (freeperl) 160 perl_free(freeperl); 161 162 PERL_SET_CONTEXT(aTHX); 163 } 164 165 int 166 Perl_ithread_hook(pTHX) 167 { 168 int veto_cleanup = 0; 169 MUTEX_LOCK(&create_destruct_mutex); 170 if (aTHX == PL_curinterp && active_threads != 1) { 171 Perl_warn(aTHX_ "A thread exited while %" IVdf " threads were running", 172 (IV)active_threads); 173 veto_cleanup = 1; 174 } 175 MUTEX_UNLOCK(&create_destruct_mutex); 176 return veto_cleanup; 177 } 178 179 void 180 Perl_ithread_detach(pTHX_ ithread *thread) 181 { 182 MUTEX_LOCK(&thread->mutex); 183 if (!(thread->state & (PERL_ITHR_DETACHED|PERL_ITHR_JOINED))) { 184 thread->state |= PERL_ITHR_DETACHED; 185 #ifdef WIN32 186 CloseHandle(thread->handle); 187 thread->handle = 0; 188 #else 189 PERL_THREAD_DETACH(thread->thr); 190 #endif 191 } 192 if ((thread->state & PERL_ITHR_FINISHED) && 193 (thread->state & PERL_ITHR_DETACHED)) { 194 MUTEX_UNLOCK(&thread->mutex); 195 Perl_ithread_destruct(aTHX_ thread, "detach"); 196 } 197 else { 198 MUTEX_UNLOCK(&thread->mutex); 199 } 200 } 201 202 /* MAGIC (in mg.h sense) hooks */ 203 204 int 205 ithread_mg_get(pTHX_ SV *sv, MAGIC *mg) 206 { 207 ithread *thread = (ithread *) mg->mg_ptr; 208 SvIV_set(sv, PTR2IV(thread)); 209 SvIOK_on(sv); 210 return 0; 211 } 212 213 int 214 ithread_mg_free(pTHX_ SV *sv, MAGIC *mg) 215 { 216 ithread *thread = (ithread *) mg->mg_ptr; 217 MUTEX_LOCK(&thread->mutex); 218 thread->count--; 219 if (thread->count == 0) { 220 if(thread->state & PERL_ITHR_FINISHED && 221 (thread->state & PERL_ITHR_DETACHED || 222 thread->state & PERL_ITHR_JOINED)) 223 { 224 MUTEX_UNLOCK(&thread->mutex); 225 Perl_ithread_destruct(aTHX_ thread, "no reference"); 226 } 227 else { 228 MUTEX_UNLOCK(&thread->mutex); 229 } 230 } 231 else { 232 MUTEX_UNLOCK(&thread->mutex); 233 } 234 return 0; 235 } 236 237 int 238 ithread_mg_dup(pTHX_ MAGIC *mg, CLONE_PARAMS *param) 239 { 240 ithread *thread = (ithread *) mg->mg_ptr; 241 MUTEX_LOCK(&thread->mutex); 242 thread->count++; 243 MUTEX_UNLOCK(&thread->mutex); 244 return 0; 245 } 246 247 MGVTBL ithread_vtbl = { 248 ithread_mg_get, /* get */ 249 0, /* set */ 250 0, /* len */ 251 0, /* clear */ 252 ithread_mg_free, /* free */ 253 0, /* copy */ 254 ithread_mg_dup /* dup */ 255 }; 256 257 258 /* 259 * Starts executing the thread. Needs to clean up memory a tad better. 260 * Passed as the C level function to run in the new thread 261 */ 262 263 #ifdef WIN32 264 THREAD_RET_TYPE 265 Perl_ithread_run(LPVOID arg) { 266 #else 267 void* 268 Perl_ithread_run(void * arg) { 269 #endif 270 ithread* thread = (ithread*) arg; 271 dTHXa(thread->interp); 272 PERL_SET_CONTEXT(thread->interp); 273 Perl_ithread_set(aTHX_ thread); 274 275 #if 0 276 /* Far from clear messing with ->thr child-side is a good idea */ 277 MUTEX_LOCK(&thread->mutex); 278 #ifdef WIN32 279 thread->thr = GetCurrentThreadId(); 280 #else 281 thread->thr = pthread_self(); 282 #endif 283 MUTEX_UNLOCK(&thread->mutex); 284 #endif 285 286 PL_perl_destruct_level = 2; 287 288 { 289 AV* params = (AV*) SvRV(thread->params); 290 I32 len = av_len(params)+1; 291 int i; 292 dSP; 293 ENTER; 294 SAVETMPS; 295 PUSHMARK(SP); 296 for(i = 0; i < len; i++) { 297 XPUSHs(av_shift(params)); 298 } 299 PUTBACK; 300 len = call_sv(thread->init_function, thread->gimme|G_EVAL); 301 302 SPAGAIN; 303 for (i=len-1; i >= 0; i--) { 304 SV *sv = POPs; 305 av_store(params, i, SvREFCNT_inc(sv)); 306 } 307 if (SvTRUE(ERRSV)) { 308 Perl_warn(aTHX_ "thread failed to start: %" SVf, ERRSV); 309 } 310 FREETMPS; 311 LEAVE; 312 SvREFCNT_dec(thread->init_function); 313 } 314 315 PerlIO_flush((PerlIO*)NULL); 316 MUTEX_LOCK(&thread->mutex); 317 thread->state |= PERL_ITHR_FINISHED; 318 319 if (thread->state & PERL_ITHR_DETACHED) { 320 MUTEX_UNLOCK(&thread->mutex); 321 Perl_ithread_destruct(aTHX_ thread, "detached finish"); 322 } else { 323 MUTEX_UNLOCK(&thread->mutex); 324 } 325 MUTEX_LOCK(&create_destruct_mutex); 326 active_threads--; 327 assert( active_threads >= 0 ); 328 MUTEX_UNLOCK(&create_destruct_mutex); 329 330 #ifdef WIN32 331 return (DWORD)0; 332 #else 333 return 0; 334 #endif 335 } 336 337 SV * 338 ithread_to_SV(pTHX_ SV *obj, ithread *thread, char *classname, bool inc) 339 { 340 SV *sv; 341 MAGIC *mg; 342 if (inc) { 343 MUTEX_LOCK(&thread->mutex); 344 thread->count++; 345 MUTEX_UNLOCK(&thread->mutex); 346 } 347 if (!obj) 348 obj = newSV(0); 349 sv = newSVrv(obj,classname); 350 sv_setiv(sv,PTR2IV(thread)); 351 mg = sv_magicext(sv,Nullsv,PERL_MAGIC_shared_scalar,&ithread_vtbl,(char *)thread,0); 352 mg->mg_flags |= MGf_DUP; 353 SvREADONLY_on(sv); 354 return obj; 355 } 356 357 ithread * 358 SV_to_ithread(pTHX_ SV *sv) 359 { 360 if (SvROK(sv)) 361 { 362 return INT2PTR(ithread*, SvIV(SvRV(sv))); 363 } 364 else 365 { 366 return Perl_ithread_get(aTHX); 367 } 368 } 369 370 /* 371 * ithread->create(); ( aka ithread->new() ) 372 * Called in context of parent thread 373 */ 374 375 SV * 376 Perl_ithread_create(pTHX_ SV *obj, char* classname, SV* init_function, SV* params) 377 { 378 ithread* thread; 379 CLONE_PARAMS clone_param; 380 ithread* current_thread = Perl_ithread_get(aTHX); 381 382 SV** tmps_tmp = PL_tmps_stack; 383 I32 tmps_ix = PL_tmps_ix; 384 #ifndef WIN32 385 int failure; 386 const char* panic = NULL; 387 #endif 388 389 390 MUTEX_LOCK(&create_destruct_mutex); 391 thread = (ithread *) PerlMemShared_malloc(sizeof(ithread)); 392 if (!thread) { 393 MUTEX_UNLOCK(&create_destruct_mutex); 394 PerlLIO_write(PerlIO_fileno(Perl_error_log), 395 PL_no_mem, strlen(PL_no_mem)); 396 my_exit(1); 397 } 398 Zero(thread,1,ithread); 399 thread->next = threads; 400 thread->prev = threads->prev; 401 threads->prev = thread; 402 thread->prev->next = thread; 403 /* Set count to 1 immediately in case thread exits before 404 * we return to caller ! 405 */ 406 thread->count = 1; 407 MUTEX_INIT(&thread->mutex); 408 thread->tid = tid_counter++; 409 thread->gimme = GIMME_V; 410 411 /* "Clone" our interpreter into the thread's interpreter 412 * This gives thread access to "static data" and code. 413 */ 414 415 PerlIO_flush((PerlIO*)NULL); 416 Perl_ithread_set(aTHX_ thread); 417 418 SAVEBOOL(PL_srand_called); /* Save this so it becomes the correct 419 value */ 420 PL_srand_called = FALSE; /* Set it to false so we can detect 421 if it gets set during the clone */ 422 423 #ifdef WIN32 424 thread->interp = perl_clone(aTHX, CLONEf_KEEP_PTR_TABLE | CLONEf_CLONE_HOST); 425 #else 426 thread->interp = perl_clone(aTHX, CLONEf_KEEP_PTR_TABLE); 427 #endif 428 /* perl_clone leaves us in new interpreter's context. 429 As it is tricky to spot an implicit aTHX, create a new scope 430 with aTHX matching the context for the duration of 431 our work for new interpreter. 432 */ 433 { 434 dTHXa(thread->interp); 435 436 /* Here we remove END blocks since they should only run 437 in the thread they are created 438 */ 439 SvREFCNT_dec(PL_endav); 440 PL_endav = newAV(); 441 clone_param.flags = 0; 442 thread->init_function = sv_dup(init_function, &clone_param); 443 if (SvREFCNT(thread->init_function) == 0) { 444 SvREFCNT_inc(thread->init_function); 445 } 446 447 448 449 thread->params = sv_dup(params, &clone_param); 450 SvREFCNT_inc(thread->params); 451 452 453 /* The code below checks that anything living on 454 the tmps stack and has been cloned (so it lives in the 455 ptr_table) has a refcount higher than 0 456 457 If the refcount is 0 it means that a something on the 458 stack/context was holding a reference to it and 459 since we init_stacks() in perl_clone that won't get 460 cleaned and we will get a leaked scalar. 461 The reason it was cloned was that it lived on the 462 @_ stack. 463 464 Example of this can be found in bugreport 15837 465 where calls in the parameter list end up as a temp 466 467 One could argue that this fix should be in perl_clone 468 */ 469 470 471 while (tmps_ix > 0) { 472 SV* sv = (SV*)ptr_table_fetch(PL_ptr_table, tmps_tmp[tmps_ix]); 473 tmps_ix--; 474 if (sv && SvREFCNT(sv) == 0) { 475 SvREFCNT_inc(sv); 476 SvREFCNT_dec(sv); 477 } 478 } 479 480 481 482 SvTEMP_off(thread->init_function); 483 ptr_table_free(PL_ptr_table); 484 PL_ptr_table = NULL; 485 PL_exit_flags |= PERL_EXIT_DESTRUCT_END; 486 } 487 Perl_ithread_set(aTHX_ current_thread); 488 PERL_SET_CONTEXT(aTHX); 489 490 /* Start the thread */ 491 492 #ifdef WIN32 493 thread->handle = CreateThread(NULL, 0, Perl_ithread_run, 494 (LPVOID)thread, 0, &thread->thr); 495 #else 496 { 497 static pthread_attr_t attr; 498 static int attr_inited = 0; 499 static int attr_joinable = PTHREAD_CREATE_JOINABLE; 500 if (!attr_inited) { 501 attr_inited = 1; 502 pthread_attr_init(&attr); 503 } 504 # ifdef PTHREAD_ATTR_SETDETACHSTATE 505 PTHREAD_ATTR_SETDETACHSTATE(&attr, attr_joinable); 506 # endif 507 # ifdef THREAD_CREATE_NEEDS_STACK 508 if(pthread_attr_setstacksize(&attr, THREAD_CREATE_NEEDS_STACK)) 509 panic = "panic: pthread_attr_setstacksize failed"; 510 # endif 511 512 #ifdef OLD_PTHREADS_API 513 failure 514 = panic ? 1 : pthread_create( &thread->thr, attr, 515 Perl_ithread_run, (void *)thread); 516 #else 517 # if defined(HAS_PTHREAD_ATTR_SETSCOPE) && defined(PTHREAD_SCOPE_SYSTEM) 518 pthread_attr_setscope( &attr, PTHREAD_SCOPE_SYSTEM ); 519 # endif 520 failure 521 = panic ? 1 : pthread_create( &thread->thr, &attr, 522 Perl_ithread_run, (void *)thread); 523 #endif 524 } 525 #endif 526 known_threads++; 527 if ( 528 #ifdef WIN32 529 thread->handle == NULL 530 #else 531 failure 532 #endif 533 ) { 534 MUTEX_UNLOCK(&create_destruct_mutex); 535 sv_2mortal(params); 536 Perl_ithread_destruct(aTHX_ thread, "create failed"); 537 #ifndef WIN32 538 if (panic) 539 Perl_croak(aTHX_ panic); 540 #endif 541 return &PL_sv_undef; 542 } 543 active_threads++; 544 MUTEX_UNLOCK(&create_destruct_mutex); 545 sv_2mortal(params); 546 547 return ithread_to_SV(aTHX_ obj, thread, classname, FALSE); 548 } 549 550 SV* 551 Perl_ithread_self (pTHX_ SV *obj, char* Class) 552 { 553 ithread *thread = Perl_ithread_get(aTHX); 554 if (thread) 555 return ithread_to_SV(aTHX_ obj, thread, Class, TRUE); 556 else 557 Perl_croak(aTHX_ "panic: cannot find thread data"); 558 return NULL; /* silence compiler warning */ 559 } 560 561 /* 562 * Joins the thread this code needs to take the returnvalue from the 563 * call_sv and send it back 564 */ 565 566 void 567 Perl_ithread_CLONE(pTHX_ SV *obj) 568 { 569 if (SvROK(obj)) 570 { 571 ithread *thread = SV_to_ithread(aTHX_ obj); 572 } 573 else 574 { 575 Perl_warn(aTHX_ "CLONE %" SVf,obj); 576 } 577 } 578 579 AV* 580 Perl_ithread_join(pTHX_ SV *obj) 581 { 582 ithread *thread = SV_to_ithread(aTHX_ obj); 583 MUTEX_LOCK(&thread->mutex); 584 if (thread->state & PERL_ITHR_DETACHED) { 585 MUTEX_UNLOCK(&thread->mutex); 586 Perl_croak(aTHX_ "Cannot join a detached thread"); 587 } 588 else if (thread->state & PERL_ITHR_JOINED) { 589 MUTEX_UNLOCK(&thread->mutex); 590 Perl_croak(aTHX_ "Thread already joined"); 591 } 592 else { 593 AV* retparam; 594 #ifdef WIN32 595 DWORD waitcode; 596 #else 597 void *retval; 598 #endif 599 MUTEX_UNLOCK(&thread->mutex); 600 #ifdef WIN32 601 waitcode = WaitForSingleObject(thread->handle, INFINITE); 602 CloseHandle(thread->handle); 603 thread->handle = 0; 604 #else 605 pthread_join(thread->thr,&retval); 606 #endif 607 MUTEX_LOCK(&thread->mutex); 608 609 /* sv_dup over the args */ 610 { 611 ithread* current_thread; 612 AV* params = (AV*) SvRV(thread->params); 613 PerlInterpreter *other_perl = thread->interp; 614 CLONE_PARAMS clone_params; 615 clone_params.stashes = newAV(); 616 clone_params.flags |= CLONEf_JOIN_IN; 617 PL_ptr_table = ptr_table_new(); 618 current_thread = Perl_ithread_get(aTHX); 619 Perl_ithread_set(aTHX_ thread); 620 /* ensure 'meaningful' addresses retain their meaning */ 621 ptr_table_store(PL_ptr_table, &other_perl->Isv_undef, &PL_sv_undef); 622 ptr_table_store(PL_ptr_table, &other_perl->Isv_no, &PL_sv_no); 623 ptr_table_store(PL_ptr_table, &other_perl->Isv_yes, &PL_sv_yes); 624 625 #if 0 626 { 627 I32 len = av_len(params)+1; 628 I32 i; 629 for(i = 0; i < len; i++) { 630 sv_dump(SvRV(AvARRAY(params)[i])); 631 } 632 } 633 #endif 634 retparam = (AV*) sv_dup((SV*)params, &clone_params); 635 #if 0 636 { 637 I32 len = av_len(retparam)+1; 638 I32 i; 639 for(i = 0; i < len; i++) { 640 sv_dump(SvRV(AvARRAY(retparam)[i])); 641 } 642 } 643 #endif 644 Perl_ithread_set(aTHX_ current_thread); 645 SvREFCNT_dec(clone_params.stashes); 646 SvREFCNT_inc(retparam); 647 ptr_table_free(PL_ptr_table); 648 PL_ptr_table = NULL; 649 650 } 651 /* We are finished with it */ 652 thread->state |= PERL_ITHR_JOINED; 653 MUTEX_UNLOCK(&thread->mutex); 654 655 return retparam; 656 } 657 return (AV*)NULL; 658 } 659 660 void 661 Perl_ithread_DESTROY(pTHX_ SV *sv) 662 { 663 ithread *thread = SV_to_ithread(aTHX_ sv); 664 sv_unmagic(SvRV(sv),PERL_MAGIC_shared_scalar); 665 } 666 667 #endif /* USE_ITHREADS */ 668 669 MODULE = threads PACKAGE = threads PREFIX = ithread_ 670 PROTOTYPES: DISABLE 671 672 #ifdef USE_ITHREADS 673 674 void 675 ithread_new (classname, function_to_call, ...) 676 char * classname 677 SV * function_to_call 678 CODE: 679 { 680 AV* params = newAV(); 681 if (items > 2) { 682 int i; 683 for(i = 2; i < items ; i++) { 684 av_push(params, SvREFCNT_inc(ST(i))); 685 } 686 } 687 ST(0) = sv_2mortal(Perl_ithread_create(aTHX_ Nullsv, classname, function_to_call, newRV_noinc((SV*) params))); 688 XSRETURN(1); 689 } 690 691 void 692 ithread_list(char *classname) 693 PPCODE: 694 { 695 ithread *curr_thread; 696 MUTEX_LOCK(&create_destruct_mutex); 697 curr_thread = threads; 698 if(curr_thread->tid != 0) 699 XPUSHs( sv_2mortal(ithread_to_SV(aTHX_ NULL, curr_thread, classname, TRUE))); 700 while(curr_thread) { 701 curr_thread = curr_thread->next; 702 if(curr_thread == threads) 703 break; 704 if(curr_thread->state & PERL_ITHR_DETACHED || 705 curr_thread->state & PERL_ITHR_JOINED) 706 continue; 707 XPUSHs( sv_2mortal(ithread_to_SV(aTHX_ NULL, curr_thread, classname, TRUE))); 708 } 709 MUTEX_UNLOCK(&create_destruct_mutex); 710 } 711 712 713 void 714 ithread_self(char *classname) 715 CODE: 716 { 717 ST(0) = sv_2mortal(Perl_ithread_self(aTHX_ Nullsv,classname)); 718 XSRETURN(1); 719 } 720 721 int 722 ithread_tid(ithread *thread) 723 724 void 725 ithread_join(SV *obj) 726 PPCODE: 727 { 728 AV* params = Perl_ithread_join(aTHX_ obj); 729 int i; 730 I32 len = AvFILL(params); 731 for (i = 0; i <= len; i++) { 732 SV* tmp = av_shift(params); 733 XPUSHs(tmp); 734 sv_2mortal(tmp); 735 } 736 SvREFCNT_dec(params); 737 } 738 739 void 740 yield(...) 741 CODE: 742 { 743 YIELD; 744 } 745 746 747 void 748 ithread_detach(ithread *thread) 749 750 void 751 ithread_DESTROY(SV *thread) 752 753 #endif /* USE_ITHREADS */ 754 755 BOOT: 756 { 757 #ifdef USE_ITHREADS 758 ithread* thread; 759 PL_perl_destruct_level = 2; 760 MUTEX_INIT(&create_destruct_mutex); 761 MUTEX_LOCK(&create_destruct_mutex); 762 PL_threadhook = &Perl_ithread_hook; 763 thread = (ithread *) PerlMemShared_malloc(sizeof(ithread)); 764 if (!thread) { 765 PerlLIO_write(PerlIO_fileno(Perl_error_log), 766 PL_no_mem, strlen(PL_no_mem)); 767 my_exit(1); 768 } 769 Zero(thread,1,ithread); 770 PL_perl_destruct_level = 2; 771 MUTEX_INIT(&thread->mutex); 772 threads = thread; 773 thread->next = thread; 774 thread->prev = thread; 775 thread->interp = aTHX; 776 thread->count = 1; /* Immortal. */ 777 thread->tid = tid_counter++; 778 known_threads++; 779 active_threads++; 780 thread->state = PERL_ITHR_DETACHED; 781 #ifdef WIN32 782 thread->thr = GetCurrentThreadId(); 783 #else 784 thread->thr = pthread_self(); 785 #endif 786 787 Perl_ithread_set(aTHX_ thread); 788 MUTEX_UNLOCK(&create_destruct_mutex); 789 #endif /* USE_ITHREADS */ 790 } 791 792