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 (executable)
--- 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 */
 }