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

1 files changed, 39 insertions, 51 deletions

diff --git a/ext/threads/threads.xs b/ext/threads/threads.xs
index df2bb67708..c65d3ce9ea 100755
--- a/ext/threads/threads.xs
+++ b/ext/threads/threads.xs
@@ -5,18 +5,10 @@
 
 #ifdef USE_ITHREADS
 
+
 #ifdef WIN32
 #include <windows.h>
 #include <win32thread.h>
-#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 <pthread.h>
 #endif
 #include <thread.h>
-
 #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 */
 }