From: Artur Bergman Date: Sat, 7 Jun 2003 13:28:50 +0000 (+0000) Subject: Major (internal) change to make it much more easy to embed X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=c05ae023d058dfbcc400f4f90916eb8a95daaf13;p=p5sagit%2Fp5-mst-13.2.git Major (internal) change to make it much more easy to embed threaded perl because we don't use our own TLS for the current thread info, but instead use PL_modglobal. Should make the mod_perl2 team (Hi Stas!) happy. Should also be more robust. p4raw-id: //depot/perl@19708 --- diff --git a/ext/threads/threads.xs b/ext/threads/threads.xs index df2bb67..c65d3ce 100755 --- a/ext/threads/threads.xs +++ b/ext/threads/threads.xs @@ -5,18 +5,10 @@ #ifdef USE_ITHREADS + #ifdef WIN32 #include #include -#define PERL_THREAD_SETSPECIFIC(k,v) TlsSetValue(k,v) -#define PERL_THREAD_GETSPECIFIC(k,v) v = TlsGetValue(k) -#define PERL_THREAD_ALLOC_SPECIFIC(k) \ -STMT_START {\ - if((k = TlsAlloc()) == TLS_OUT_OF_INDEXES) {\ - PerlIO_printf(PerlIO_stderr(), "panic threads.xs: TlsAlloc");\ - exit(1);\ - }\ -} STMT_END #else #ifdef OS2 typedef perl_os_thread pthread_t; @@ -24,34 +16,17 @@ typedef perl_os_thread pthread_t; #include #endif #include - #define PERL_THREAD_SETSPECIFIC(k,v) pthread_setspecific(k,v) #ifdef OLD_PTHREADS_API #define PERL_THREAD_DETACH(t) pthread_detach(&(t)) -#define PERL_THREAD_GETSPECIFIC(k,v) pthread_getspecific(k,&v) -#define PERL_THREAD_ALLOC_SPECIFIC(k) STMT_START {\ - if(pthread_keycreate(&(k),0)) {\ - PerlIO_printf(PerlIO_stderr(), "panic threads.xs: pthread_key_create");\ - exit(1);\ - }\ -} STMT_END #else #define PERL_THREAD_DETACH(t) pthread_detach((t)) -#define PERL_THREAD_GETSPECIFIC(k,v) v = pthread_getspecific(k) -#define PERL_THREAD_ALLOC_SPECIFIC(k) STMT_START {\ - if(pthread_key_create(&(k),0)) {\ - PerlIO_printf(PerlIO_stderr(), "panic threads.xs: pthread_key_create");\ - exit(1);\ - }\ -} STMT_END -#endif -#endif -#ifdef OEMVS -# define PERL_THREAD_GETSPECIFIC_THREAD(k, t) STMT_START { void *gsptr; PERL_THREAD_GETSPECIFIC(k, gsptr); t = (ithread *) gsptr; } STMT_END -#else -# define PERL_THREAD_GETSPECIFIC_THREAD(k, t) PERL_THREAD_GETSPECIFIC(k, t) +#endif /* OLD_PTHREADS_API */ #endif + + + /* Values for 'state' member */ #define PERL_ITHR_JOINABLE 0 #define PERL_ITHR_DETACHED 1 @@ -92,7 +67,25 @@ static perl_mutex create_destruct_mutex; /* protects the creation and destructi I32 tid_counter = 0; I32 known_threads = 0; I32 active_threads = 0; -perl_key self_key; + + +void Perl_ithread_set (pTHX_ ithread* thread) +{ + SV* thread_sv = newSViv((IV)thread); + if(!hv_store(PL_modglobal, "threads::self", 12, thread_sv,0)) { + croak("%s\n","Internal error, couldn't set TLS"); + } +} + +ithread* Perl_ithread_get (pTHX) { + SV** thread_sv = hv_fetch(PL_modglobal, "threads::self",12,0); + if(!thread_sv) { + croak("%s\n","Internal error, couldn't get TLS"); + } + return (ithread*)SvIV(*thread_sv); +} + + /* * Clear up after thread is done with @@ -139,8 +132,9 @@ Perl_ithread_destruct (pTHX_ ithread* thread, const char *why) void *ptr; #endif PERL_SET_CONTEXT(thread->interp); - PERL_THREAD_GETSPECIFIC_THREAD(self_key, current_thread); - PERL_THREAD_SETSPECIFIC(self_key,thread); + current_thread = Perl_ithread_get(aTHX); + Perl_ithread_set(aTHX_ thread); + @@ -152,8 +146,6 @@ Perl_ithread_destruct (pTHX_ ithread* thread, const char *why) perl_destruct(thread->interp); perl_free(thread->interp); thread->interp = NULL; - PERL_THREAD_SETSPECIFIC(self_key,current_thread); - } MUTEX_UNLOCK(&thread->mutex); MUTEX_DESTROY(&thread->mutex); @@ -270,7 +262,7 @@ Perl_ithread_run(void * arg) { ithread* thread = (ithread*) arg; dTHXa(thread->interp); PERL_SET_CONTEXT(thread->interp); - PERL_THREAD_SETSPECIFIC(self_key,thread); + Perl_ithread_set(aTHX_ thread); #if 0 /* Far from clear messing with ->thr child-side is a good idea */ @@ -357,16 +349,14 @@ ithread_to_SV(pTHX_ SV *obj, ithread *thread, char *classname, bool inc) ithread * SV_to_ithread(pTHX_ SV *sv) { - ithread *thread; if (SvROK(sv)) { - thread = INT2PTR(ithread*, SvIV(SvRV(sv))); + return INT2PTR(ithread*, SvIV(SvRV(sv))); } else { - PERL_THREAD_GETSPECIFIC_THREAD(self_key, thread); + return Perl_ithread_get(aTHX); } - return thread; } /* @@ -379,12 +369,12 @@ Perl_ithread_create(pTHX_ SV *obj, char* classname, SV* init_function, SV* param { ithread* thread; CLONE_PARAMS clone_param; - ithread* current_thread; + ithread* current_thread = Perl_ithread_get(aTHX); SV** tmps_tmp = PL_tmps_stack; I32 tmps_ix = PL_tmps_ix; - PERL_THREAD_GETSPECIFIC_THREAD(self_key, current_thread); + MUTEX_LOCK(&create_destruct_mutex); thread = PerlMemShared_malloc(sizeof(ithread)); Zero(thread,1,ithread); @@ -405,7 +395,7 @@ Perl_ithread_create(pTHX_ SV *obj, char* classname, SV* init_function, SV* param */ PerlIO_flush((PerlIO*)NULL); - PERL_THREAD_SETSPECIFIC(self_key,thread); + Perl_ithread_set(aTHX_ thread); SAVEBOOL(PL_srand_called); /* Save this so it becomes the correct value */ @@ -476,7 +466,7 @@ Perl_ithread_create(pTHX_ SV *obj, char* classname, SV* init_function, SV* param PL_ptr_table = NULL; PL_exit_flags |= PERL_EXIT_DESTRUCT_END; } - PERL_THREAD_SETSPECIFIC(self_key,current_thread); + Perl_ithread_set(aTHX_ current_thread); PERL_SET_CONTEXT(aTHX); /* Start the thread */ @@ -524,8 +514,7 @@ Perl_ithread_create(pTHX_ SV *obj, char* classname, SV* init_function, SV* param SV* Perl_ithread_self (pTHX_ SV *obj, char* Class) { - ithread *thread; - PERL_THREAD_GETSPECIFIC_THREAD(self_key, thread); + ithread *thread = Perl_ithread_get(aTHX); if (thread) return ithread_to_SV(aTHX_ obj, thread, Class, TRUE); else @@ -586,8 +575,8 @@ Perl_ithread_join(pTHX_ SV *obj) clone_params.stashes = newAV(); clone_params.flags |= CLONEf_JOIN_IN; PL_ptr_table = ptr_table_new(); - PERL_THREAD_GETSPECIFIC_THREAD(self_key, current_thread); - PERL_THREAD_SETSPECIFIC(self_key,thread); + current_thread = Perl_ithread_get(aTHX); + Perl_ithread_set(aTHX_ thread); #if 0 { @@ -608,7 +597,7 @@ Perl_ithread_join(pTHX_ SV *obj) } } #endif - PERL_THREAD_SETSPECIFIC(self_key,current_thread); + Perl_ithread_set(aTHX_ current_thread); SvREFCNT_dec(clone_params.stashes); SvREFCNT_inc(retparam); ptr_table_free(PL_ptr_table); @@ -724,7 +713,6 @@ BOOT: #ifdef USE_ITHREADS ithread* thread; PL_perl_destruct_level = 2; - PERL_THREAD_ALLOC_SPECIFIC(self_key); MUTEX_INIT(&create_destruct_mutex); MUTEX_LOCK(&create_destruct_mutex); PL_threadhook = &Perl_ithread_hook; @@ -747,7 +735,7 @@ BOOT: thread->thr = pthread_self(); #endif - PERL_THREAD_SETSPECIFIC(self_key,thread); + Perl_ithread_set(aTHX_ thread); MUTEX_UNLOCK(&create_destruct_mutex); #endif /* USE_ITHREADS */ }