From: Artur Bergman <sky@nanisky.com>
Date: Fri, 12 Oct 2001 12:46:15 +0000 (+0000)
Subject: A) Support OLD_PTHREADS_API
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=82c40bf6e04dd4097ac1971f1cce87fd35ccf6d2;p=p5sagit%2Fp5-mst-13.2.git

A) Support OLD_PTHREADS_API
B) Change from using pthread_t to using a TLS to store the
index of the thread in an hash, this is to avoid problems when
in fact pthread_t was not a seralizable type.
Both these changes are because of HP-UX 10.20
This has not been tested on win32 but should work there.
Need to add support for NetWare.

p4raw-id: //depot/perl@12404
---

diff --git a/ext/threads/threads.h b/ext/threads/threads.h
index 5fef2bd..d8c0dab 100755
--- a/ext/threads/threads.h
+++ b/ext/threads/threads.h
@@ -8,9 +8,33 @@
 #ifdef WIN32
 #include <windows.h>
 #include <win32thread.h>
+#define PERL_THREAD_DETACH(t) 
+#define PERL_THREAD_SET_SPECIFIC(k,v) TlsSetValue(k,v)
+#define PERL_THREAD_GET_SPECIFIC(k)   TlsGetValue(k)
+#define PERL_THREAD_ALLOC_SPECIFIC(k) \
+STMT_START {\
+  if((k = TlsAlloc()) == TLS_OUT_OF_INDEXES) {\
+    PerlIO_printf(PerlIO_stderr(),"panic threads.h: TlsAlloc");\
+    exit(1);\
+  }\
+} STMT_END
 #else
 #include <pthread.h>
 #include <thread.h>
+
+#define PERL_THREAD_SET_SPECIFIC(k,v) pthread_setspecific(k,v)
+#define PERL_THREAD_GET_SPECIFIC(k)   PTHREAD_GETSPECIFIC(k)
+#define PERL_THREAD_ALLOC_SPECIFIC(k) STMT_START {\
+  if(pthread_key_create(&(k),0)) {\
+    PerlIO_printf(PerlIO_stderr(), "panic threads.h: pthread_key_create");\
+    exit(1);\
+  }\
+} STMT_END
+#ifdef OLD_PTHREADS_API
+#define PERL_THREAD_DETACH(t) pthread_detach(&(t))
+#else
+#define PERL_THREAD_DETACH(t) pthread_detach((t))
+#endif
 #endif
 
 typedef struct {
@@ -38,7 +62,7 @@ static perl_mutex create_mutex;  /* protects the creation of threads ??? */
 I32 tid_counter = 1;
 shared_sv* threads;
 
-
+perl_key self_key;
 
 
 
diff --git a/ext/threads/threads.xs b/ext/threads/threads.xs
index 5caedbe..1dc4e39 100755
--- a/ext/threads/threads.xs
+++ b/ext/threads/threads.xs
@@ -23,7 +23,9 @@ void* Perl_thread_run(void * arg) {
 
 	SHAREDSvLOCK(threads);
 	SHAREDSvEDIT(threads);
-	thread_tid_ptr = Perl_newSVuv(PL_sharedsv_space, PTR2UV(thread->thr));
+	PERL_THREAD_ALLOC_SPECIFIC(self_key);
+	PERL_THREAD_SET_SPECIFIC(self_key,INT2PTR(void*,thread->tid));
+	thread_tid_ptr = Perl_newSVuv(PL_sharedsv_space, PTR2UV(PERL_THREAD_GET_SPECIFIC(self_key)));	
 	thread_ptr = Perl_newSVuv(PL_sharedsv_space, PTR2UV(thread));
 	hv_store_ent((HV*)SHAREDSvGET(threads), thread_tid_ptr, thread_ptr,0);
    	SvREFCNT_dec(thread_tid_ptr);
@@ -152,9 +154,14 @@ SV* Perl_thread_create(char* class, SV* init_function, SV* params) {
 	thread->handle = CreateThread(NULL, 0, Perl_thread_run,
 			(LPVOID)thread, 0, &thread->thr);
 
+
+#else
+#ifdef OLD_PTHREADS_API
+	pthread_create( &thread->thr, (pthread_attr_t)NULL, Perl_thread_run, thread);
 #else
 	pthread_create( &thread->thr, (pthread_attr_t*)NULL, Perl_thread_run, thread);
 #endif
+#endif
 	MUTEX_UNLOCK(&create_mutex);	
 
 	return obj_ref;
@@ -185,13 +192,9 @@ SV* Perl_thread_self (char* class) {
 	
 	SHAREDSvLOCK(threads);
 	SHAREDSvEDIT(threads);
-#ifdef WIN32
-	thread_tid_ptr = Perl_newSVuv(PL_sharedsv_space,
-				      (UV) GetCurrentThreadId());
-#else
-	thread_tid_ptr = Perl_newSVuv(PL_sharedsv_space,
-				      PTR2UV(pthread_self()));
-#endif
+
+	thread_tid_ptr = Perl_newSVuv(PL_sharedsv_space, PTR2UV(PERL_THREAD_GET_SPECIFIC(self_key)));	
+
 	thread_entry = Perl_hv_fetch_ent(PL_sharedsv_space,
 					 (HV*) SHAREDSvGET(threads),
 					 thread_tid_ptr, 0,0);
@@ -229,9 +232,7 @@ void Perl_thread_detach(SV* obj) {
 	ithread* thread = (ithread*)SvIV(SvRV(obj));
 	MUTEX_LOCK(&thread->mutex);
 	thread->detached = 1;
-#if !defined(WIN32)
-	pthread_detach(thread->thr);
-#endif
+	PERL_THREAD_DETACH(thread->thr);
 	MUTEX_UNLOCK(&thread->mutex);
 }
 
@@ -283,7 +284,9 @@ BOOT:
 		thread->thr = pthread_self();
 #endif
 		SHAREDSvEDIT(threads);
-		thread_tid_ptr = Perl_newSVuv(PL_sharedsv_space, PTR2UV(thread->thr));
+		PERL_THREAD_ALLOC_SPECIFIC(self_key);
+		PERL_THREAD_SET_SPECIFIC(self_key,0);
+		thread_tid_ptr = Perl_newSVuv(PL_sharedsv_space, PTR2UV(PERL_THREAD_GET_SPECIFIC(self_key)));
 		thread_ptr = Perl_newSVuv(PL_sharedsv_space, PTR2UV(thread));
 		hv_store_ent((HV*) SHAREDSvGET(threads), thread_tid_ptr, thread_ptr,0);
 	   	SvREFCNT_dec(thread_tid_ptr);