X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=ext%2Fthreads%2Fthreads.xs;h=59e3597aadba329939d9a6b195d9518458b39467;hb=65575be5af9681bf691b8b72b0e5b7f432a867bf;hp=83dca9325769d9423b2209357a5d0b00677e865b;hpb=3275ba964c17f100af90c1175c6541dabcee6dbb;p=p5sagit%2Fp5-mst-13.2.git diff --git a/ext/threads/threads.xs b/ext/threads/threads.xs index 83dca93..59e3597 100755 --- a/ext/threads/threads.xs +++ b/ext/threads/threads.xs @@ -3,6 +3,8 @@ #include "perl.h" #include "XSUB.h" +#ifdef USE_ITHREADS + #ifdef WIN32 #include #include @@ -41,6 +43,12 @@ STMT_START {\ #endif #endif +/* Values for 'state' member */ +#define PERL_ITHR_JOINABLE 0 +#define PERL_ITHR_DETACHED 1 +#define PERL_ITHR_FINISHED 4 +#define PERL_ITHR_JOINED 2 + typedef struct ithread_s { struct ithread_s *next; /* next thread in the list */ struct ithread_s *prev; /* prev thread in the list */ @@ -48,7 +56,7 @@ typedef struct ithread_s { I32 tid; /* threads module's thread id */ perl_mutex mutex; /* mutex for updating things in this struct */ I32 count; /* how many SVs have a reference to us */ - signed char detached; /* are we detached ? */ + signed char state; /* are we detached ? */ int gimme; /* Context of create */ SV* init_function; /* Code to run */ SV* params; /* args to pass function */ @@ -68,54 +76,103 @@ ithread *threads; #define ithread_CLONE(thread) Perl_ithread_CLONE(aTHX_ thread) #define ithread_detach(thread) Perl_ithread_detach(aTHX_ thread) #define ithread_tid(thread) ((thread)->tid) +#define ithread_yield(thread) (YIELD); -static perl_mutex create_mutex; /* protects the creation of threads ??? */ +static perl_mutex create_destruct_mutex; /* protects the creation and destruction of threads*/ I32 tid_counter = 0; - +I32 known_threads = 0; +I32 active_threads = 0; perl_key self_key; /* * Clear up after thread is done with */ void -Perl_ithread_destruct (pTHX_ ithread* thread) +Perl_ithread_destruct (pTHX_ ithread* thread, const char *why) { MUTEX_LOCK(&thread->mutex); + if (!thread->next) { + Perl_croak(aTHX_ "panic: destruct destroyed thread %p (%s)",thread, why); + } if (thread->count != 0) { MUTEX_UNLOCK(&thread->mutex); return; } - MUTEX_LOCK(&create_mutex); + MUTEX_LOCK(&create_destruct_mutex); /* Remove from circular list of threads */ if (thread->next == thread) { /* last one should never get here ? */ threads = NULL; } else { - thread->next->prev = thread->prev->next; - thread->prev->next = thread->next->prev; + thread->next->prev = thread->prev; + thread->prev->next = thread->next; if (threads == thread) { threads = thread->next; } + thread->next = NULL; + thread->prev = NULL; } - MUTEX_UNLOCK(&create_mutex); - /* Thread is now disowned */ + known_threads--; + assert( known_threads >= 0 ); #if 0 - Perl_warn(aTHX_ "destruct %d @ %p by %p", - thread->tid,thread->interp,aTHX); + Perl_warn(aTHX_ "destruct %d @ %p by %p now %d", + thread->tid,thread->interp,aTHX, known_threads); #endif + MUTEX_UNLOCK(&create_destruct_mutex); + /* Thread is now disowned */ if (thread->interp) { dTHXa(thread->interp); PERL_SET_CONTEXT(thread->interp); + SvREFCNT_dec(thread->params); + thread->params = Nullsv; perl_destruct(thread->interp); perl_free(thread->interp); thread->interp = NULL; } PERL_SET_CONTEXT(aTHX); MUTEX_UNLOCK(&thread->mutex); + MUTEX_DESTROY(&thread->mutex); + PerlMemShared_free(thread); } +int +Perl_ithread_hook(pTHX) +{ + int veto_cleanup = 0; + MUTEX_LOCK(&create_destruct_mutex); + if (aTHX == PL_curinterp && active_threads != 1) { + Perl_warn(aTHX_ "A thread exited while %" IVdf " other threads were still running", + (IV)active_threads); + veto_cleanup = 1; + } + MUTEX_UNLOCK(&create_destruct_mutex); + return veto_cleanup; +} + +void +Perl_ithread_detach(pTHX_ ithread *thread) +{ + MUTEX_LOCK(&thread->mutex); + if (!(thread->state & (PERL_ITHR_DETACHED|PERL_ITHR_JOINED))) { + thread->state |= PERL_ITHR_DETACHED; +#ifdef WIN32 + CloseHandle(thread->handle); + thread->handle = 0; +#else + PERL_THREAD_DETACH(thread->thr); +#endif + } + if ((thread->state & PERL_ITHR_FINISHED) && + (thread->state & PERL_ITHR_DETACHED)) { + MUTEX_UNLOCK(&thread->mutex); + Perl_ithread_destruct(aTHX_ thread, "detach"); + } + else { + MUTEX_UNLOCK(&thread->mutex); + } +} /* MAGIC (in mg.h sense) hooks */ @@ -134,9 +191,21 @@ ithread_mg_free(pTHX_ SV *sv, MAGIC *mg) ithread *thread = (ithread *) mg->mg_ptr; MUTEX_LOCK(&thread->mutex); thread->count--; - MUTEX_UNLOCK(&thread->mutex); - /* This is safe as it re-checks count */ - Perl_ithread_destruct(aTHX_ thread); + if (thread->count == 0) { + if(thread->state & PERL_ITHR_FINISHED && + (thread->state & PERL_ITHR_DETACHED || + thread->state & PERL_ITHR_JOINED)) + { + MUTEX_UNLOCK(&thread->mutex); + Perl_ithread_destruct(aTHX_ thread, "no reference"); + } + else { + MUTEX_UNLOCK(&thread->mutex); + } + } + else { + MUTEX_UNLOCK(&thread->mutex); + } return 0; } @@ -211,7 +280,7 @@ Perl_ithread_run(void * arg) { } PUTBACK; if (SvTRUE(ERRSV)) { - Perl_warn(aTHX_ "Died:%_",ERRSV); + Perl_warn(aTHX_ "thread failed to start: %" SVf, ERRSV); } FREETMPS; LEAVE; @@ -220,15 +289,19 @@ Perl_ithread_run(void * arg) { PerlIO_flush((PerlIO*)NULL); MUTEX_LOCK(&thread->mutex); - if (thread->detached & 1) { + thread->state |= PERL_ITHR_FINISHED; + + if (thread->state & PERL_ITHR_DETACHED) { MUTEX_UNLOCK(&thread->mutex); - SvREFCNT_dec(thread->params); - thread->params = Nullsv; - Perl_ithread_destruct(aTHX_ thread); + Perl_ithread_destruct(aTHX_ thread, "detached finish"); } else { - thread->detached |= 4; - MUTEX_UNLOCK(&thread->mutex); - } + MUTEX_UNLOCK(&thread->mutex); + } + MUTEX_LOCK(&create_destruct_mutex); + active_threads--; + assert( active_threads >= 0 ); + MUTEX_UNLOCK(&create_destruct_mutex); + #ifdef WIN32 return (DWORD)0; #else @@ -282,11 +355,12 @@ Perl_ithread_create(pTHX_ SV *obj, char* classname, SV* init_function, SV* param ithread* thread; CLONE_PARAMS clone_param; - MUTEX_LOCK(&create_mutex); + MUTEX_LOCK(&create_destruct_mutex); thread = PerlMemShared_malloc(sizeof(ithread)); Zero(thread,1,ithread); thread->next = threads; thread->prev = threads->prev; + threads->prev = thread; thread->prev->next = thread; /* Set count to 1 immediately in case thread exits before * we return to caller ! @@ -295,7 +369,6 @@ Perl_ithread_create(pTHX_ SV *obj, char* classname, SV* init_function, SV* param MUTEX_INIT(&thread->mutex); thread->tid = tid_counter++; thread->gimme = GIMME_V; - thread->detached = (thread->gimme == G_VOID) ? 1 : 0; /* "Clone" our interpreter into the thread's interpreter * This gives thread access to "static data" and code. @@ -315,7 +388,11 @@ Perl_ithread_create(pTHX_ SV *obj, char* classname, SV* init_function, SV* param */ { dTHXa(thread->interp); - + /* Here we remove END blocks since they should only run + in the thread they are created + */ + SvREFCNT_dec(PL_endav); + PL_endav = newAV(); clone_param.flags = 0; thread->init_function = sv_dup(init_function, &clone_param); if (SvREFCNT(thread->init_function) == 0) { @@ -327,6 +404,7 @@ Perl_ithread_create(pTHX_ SV *obj, char* classname, SV* init_function, SV* param SvTEMP_off(thread->init_function); ptr_table_free(PL_ptr_table); PL_ptr_table = NULL; + PL_exit_flags |= PERL_EXIT_DESTRUCT_END; } PERL_SET_CONTEXT(aTHX); @@ -342,7 +420,6 @@ Perl_ithread_create(pTHX_ SV *obj, char* classname, SV* init_function, SV* param { static pthread_attr_t attr; static int attr_inited = 0; - sigset_t fullmask, oldmask; static int attr_joinable = PTHREAD_CREATE_JOINABLE; if (!attr_inited) { attr_inited = 1; @@ -363,7 +440,10 @@ Perl_ithread_create(pTHX_ SV *obj, char* classname, SV* init_function, SV* param #endif } #endif - MUTEX_UNLOCK(&create_mutex); + known_threads++; + active_threads++; + MUTEX_UNLOCK(&create_destruct_mutex); + sv_2mortal(params); return ithread_to_SV(aTHX_ obj, thread, classname, FALSE); } @@ -389,20 +469,20 @@ Perl_ithread_CLONE(pTHX_ SV *obj) } else { - Perl_warn(aTHX_ "CLONE %_",obj); + Perl_warn(aTHX_ "CLONE %" SVf,obj); } } -AV* +AV* Perl_ithread_join(pTHX_ SV *obj) { ithread *thread = SV_to_ithread(aTHX_ obj); MUTEX_LOCK(&thread->mutex); - if (thread->detached & 1) { + if (thread->state & PERL_ITHR_DETACHED) { MUTEX_UNLOCK(&thread->mutex); Perl_croak(aTHX_ "Cannot join a detached thread"); } - else if (thread->detached & 2) { + else if (thread->state & PERL_ITHR_JOINED) { MUTEX_UNLOCK(&thread->mutex); Perl_croak(aTHX_ "Thread already joined"); } @@ -421,8 +501,9 @@ Perl_ithread_join(pTHX_ SV *obj) #endif MUTEX_LOCK(&thread->mutex); + /* sv_dup over the args */ { - AV* params = (AV*) SvRV(thread->params); + AV* params = (AV*) SvRV(thread->params); CLONE_PARAMS clone_params; clone_params.stashes = newAV(); PL_ptr_table = ptr_table_new(); @@ -433,46 +514,29 @@ Perl_ithread_join(pTHX_ SV *obj) PL_ptr_table = NULL; } - /* sv_dup over the args */ /* We have finished with it */ - thread->detached |= 2; + thread->state |= PERL_ITHR_JOINED; MUTEX_UNLOCK(&thread->mutex); - sv_unmagic(SvRV(obj),PERL_MAGIC_shared_scalar); - Perl_ithread_destruct(aTHX_ thread); + sv_unmagic(SvRV(obj),PERL_MAGIC_shared_scalar); return retparam; } return (AV*)NULL; } void -Perl_ithread_detach(pTHX_ ithread *thread) -{ - MUTEX_LOCK(&thread->mutex); - if (!thread->detached) { - thread->detached = 1; -#ifdef WIN32 - CloseHandle(thread->handle); - thread->handle = 0; -#else - PERL_THREAD_DETACH(thread->thr); -#endif - } - MUTEX_UNLOCK(&thread->mutex); -} - - -void Perl_ithread_DESTROY(pTHX_ SV *sv) { ithread *thread = SV_to_ithread(aTHX_ sv); sv_unmagic(SvRV(sv),PERL_MAGIC_shared_scalar); } - +#endif /* USE_ITHREADS */ MODULE = threads PACKAGE = threads PREFIX = ithread_ PROTOTYPES: DISABLE +#ifdef USE_ITHREADS + void ithread_new (classname, function_to_call, ...) char * classname @@ -483,7 +547,7 @@ CODE: if (items > 2) { int i; for(i = 2; i < items ; i++) { - av_push(params, ST(i)); + av_push(params, SvREFCNT_inc(ST(i))); } } ST(0) = sv_2mortal(Perl_ithread_create(aTHX_ Nullsv, classname, function_to_call, newRV_noinc((SV*) params))); @@ -491,6 +555,27 @@ CODE: } void +ithread_list(char *classname) +PPCODE: +{ + ithread *curr_thread; + MUTEX_LOCK(&create_destruct_mutex); + curr_thread = threads; + PUSHs( sv_2mortal(ithread_to_SV(aTHX_ NULL, curr_thread, classname, TRUE))); + while(curr_thread) { + curr_thread = curr_thread->next; + if(curr_thread == threads) + break; + if(curr_thread->state & PERL_ITHR_DETACHED || + curr_thread->state & PERL_ITHR_JOINED) + continue; + PUSHs( sv_2mortal(ithread_to_SV(aTHX_ NULL, curr_thread, classname, TRUE))); + } + MUTEX_UNLOCK(&create_destruct_mutex); +} + + +void ithread_self(char *classname) CODE: { @@ -509,11 +594,20 @@ PPCODE: int i; I32 len = AvFILL(params); for (i = 0; i <= len; i++) { - XPUSHs(av_shift(params)); + SV* tmp = av_shift(params); + XPUSHs(tmp); + sv_2mortal(tmp); } SvREFCNT_dec(params); } +void +yield(...) +CODE: +{ + YIELD; +} + void ithread_detach(ithread *thread) @@ -521,13 +615,17 @@ ithread_detach(ithread *thread) void ithread_DESTROY(SV *thread) +#endif /* USE_ITHREADS */ + BOOT: { +#ifdef USE_ITHREADS ithread* thread; PL_perl_destruct_level = 2; PERL_THREAD_ALLOC_SPECIFIC(self_key); - MUTEX_INIT(&create_mutex); - MUTEX_LOCK(&create_mutex); + MUTEX_INIT(&create_destruct_mutex); + MUTEX_LOCK(&create_destruct_mutex); + PL_threadhook = &Perl_ithread_hook; thread = PerlMemShared_malloc(sizeof(ithread)); Zero(thread,1,ithread); PL_perl_destruct_level = 2; @@ -538,13 +636,17 @@ BOOT: thread->interp = aTHX; thread->count = 1; /* imortal */ thread->tid = tid_counter++; - thread->detached = 1; + known_threads++; + active_threads++; + thread->state = 1; #ifdef WIN32 thread->thr = GetCurrentThreadId(); #else thread->thr = pthread_self(); #endif + PERL_THREAD_SETSPECIFIC(self_key,thread); - MUTEX_UNLOCK(&create_mutex); + MUTEX_UNLOCK(&create_destruct_mutex); +#endif /* USE_ITHREADS */ }