X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=ext%2Fthreads%2Fthreads.xs;h=48530fea617e346fda46a87b9e539e019c9870fa;hb=87c9b3a674e8d668946befbd197e1e7dcbafd7e6;hp=2bb5856a52a7cb6c858fff2e3693be156145248e;hpb=3e79ab2c0772803c81d42fa8edf7827e514e1914;p=p5sagit%2Fp5-mst-13.2.git diff --git a/ext/threads/threads.xs b/ext/threads/threads.xs index 2bb5856..48530fe 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,29 +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 /* OLD_PTHREADS_API */ #endif + + + /* Values for 'state' member */ #define PERL_ITHR_JOINABLE 0 #define PERL_ITHR_DETACHED 1 @@ -87,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(PTR2IV(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 INT2PTR(ithread*,SvIV(*thread_sv)); +} + + /* * Clear up after thread is done with @@ -134,13 +132,9 @@ Perl_ithread_destruct (pTHX_ ithread* thread, const char *why) void *ptr; #endif PERL_SET_CONTEXT(thread->interp); -#ifdef OEMVS - PERL_THREAD_GETSPECIFIC(self_key,ptr); - current_thread = (ithread *) ptr; -#else - PERL_THREAD_GETSPECIFIC(self_key,current_thread); -#endif - 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,24 +349,14 @@ ithread_to_SV(pTHX_ SV *obj, ithread *thread, char *classname, bool inc) ithread * SV_to_ithread(pTHX_ SV *sv) { - ithread *thread; -#ifdef OEMVS - void *ptr; -#endif if (SvROK(sv)) { - thread = INT2PTR(ithread*, SvIV(SvRV(sv))); + return INT2PTR(ithread*, SvIV(SvRV(sv))); } else { -#ifdef OEMVS - PERL_THREAD_GETSPECIFIC(self_key,ptr); - thread = (ithread *) ptr; -#else - PERL_THREAD_GETSPECIFIC(self_key,thread); -#endif + return Perl_ithread_get(aTHX); } - return thread; } /* @@ -387,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(self_key,current_thread); + MUTEX_LOCK(&create_destruct_mutex); thread = PerlMemShared_malloc(sizeof(ithread)); Zero(thread,1,ithread); @@ -413,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 */ @@ -484,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 */ @@ -532,18 +514,12 @@ Perl_ithread_create(pTHX_ SV *obj, char* classname, SV* init_function, SV* param SV* Perl_ithread_self (pTHX_ SV *obj, char* Class) { - ithread *thread; -#ifdef OEMVS - void *ptr; - PERL_THREAD_GETSPECIFIC(self_key,ptr); - thread = (ithread *) ptr; -#else - PERL_THREAD_GETSPECIFIC(self_key,thread); -#endif + ithread *thread = Perl_ithread_get(aTHX); if (thread) return ithread_to_SV(aTHX_ obj, thread, Class, TRUE); else Perl_croak(aTHX_ "panic: cannot find thread data"); + return NULL; /* silence compiler warning */ } /* @@ -596,12 +572,17 @@ Perl_ithread_join(pTHX_ SV *obj) { ithread* current_thread; AV* params = (AV*) SvRV(thread->params); + PerlInterpreter *other_perl = thread->interp; CLONE_PARAMS clone_params; clone_params.stashes = newAV(); clone_params.flags |= CLONEf_JOIN_IN; PL_ptr_table = ptr_table_new(); - PERL_THREAD_GETSPECIFIC(self_key,current_thread); - PERL_THREAD_SETSPECIFIC(self_key,thread); + current_thread = Perl_ithread_get(aTHX); + Perl_ithread_set(aTHX_ thread); + /* ensure 'meaningful' addresses retain their meaning */ + ptr_table_store(PL_ptr_table, &other_perl->Isv_undef, &PL_sv_undef); + ptr_table_store(PL_ptr_table, &other_perl->Isv_no, &PL_sv_no); + ptr_table_store(PL_ptr_table, &other_perl->Isv_yes, &PL_sv_yes); #if 0 { @@ -622,7 +603,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); @@ -738,7 +719,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; @@ -761,7 +741,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 */ }