X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=ext%2Fthreads%2Fthreads.xs;h=df2bb67708a00ded53d74653be64e767082b5f23;hb=a31a65c0bb15a314af697dcdcc79bc9e66e65a12;hp=4e34a40f0b9d7d30f6bbe1a80722315e4b923c5b;hpb=ddcc6fdc2c2811c8014d35126e40f07b13b87e32;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/ext/threads/threads.xs b/ext/threads/threads.xs
index 4e34a40..df2bb67 100755
--- a/ext/threads/threads.xs
+++ b/ext/threads/threads.xs
@@ -13,7 +13,7 @@
 #define PERL_THREAD_ALLOC_SPECIFIC(k) \
 STMT_START {\
   if((k = TlsAlloc()) == TLS_OUT_OF_INDEXES) {\
-    PerlIO_printf(PerlIO_stderr(),"panic threads.xs: TlsAlloc");\
+    PerlIO_printf(PerlIO_stderr(), "panic threads.xs: TlsAlloc");\
     exit(1);\
   }\
 } STMT_END
@@ -46,6 +46,11 @@ typedef perl_os_thread pthread_t;
 } 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
 
 /* Values for 'state' member */
 #define PERL_ITHR_JOINABLE		0
@@ -54,16 +59,16 @@ typedef perl_os_thread pthread_t;
 #define PERL_ITHR_JOINED		2
 
 typedef struct ithread_s {
-    struct ithread_s *next;	/* next thread in the list */
-    struct ithread_s *prev;	/* prev thread in the list */
+    struct ithread_s *next;	/* Next thread in the list */
+    struct ithread_s *prev;	/* Prev thread in the list */
     PerlInterpreter *interp;	/* The threads interpreter */
-    I32 tid;              	/* threads module's thread id */
-    perl_mutex mutex; 		/* mutex for updating things in this struct */
-    I32 count;			/* how many SVs have a reference to us */
-    signed char state;		/* are we detached ? */
+    I32 tid;              	/* Threads module's thread id */
+    perl_mutex mutex; 		/* Mutex for updating things in this struct */
+    I32 count;			/* How many SVs have a reference to us */
+    signed char state;		/* Are we detached ? */
     int gimme;			/* Context of create */
     SV* init_function;          /* Code to run */
-    SV* params;                 /* args to pass function */
+    SV* params;                 /* Args to pass function */
 #ifdef WIN32
 	DWORD	thr;            /* OS's idea if thread id */
 	HANDLE handle;          /* OS's waitable handle */
@@ -130,8 +135,11 @@ Perl_ithread_destruct (pTHX_ ithread* thread, const char *why)
 	if(thread->interp) {
 	    dTHXa(thread->interp);
 	    ithread*        current_thread;
+#ifdef OEMVS
+	    void *ptr;
+#endif
 	    PERL_SET_CONTEXT(thread->interp);
-	    PERL_THREAD_GETSPECIFIC(self_key,current_thread);
+	    PERL_THREAD_GETSPECIFIC_THREAD(self_key, current_thread);
 	    PERL_THREAD_SETSPECIFIC(self_key,thread);
 
 
@@ -350,27 +358,19 @@ ithread *
 SV_to_ithread(pTHX_ SV *sv)
 {
     ithread *thread;
-#ifdef OEMVS
-    void *ptr;
-#endif
     if (SvROK(sv))
      {
       thread = 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
+      PERL_THREAD_GETSPECIFIC_THREAD(self_key, thread);
      }
     return thread;
 }
 
 /*
- * iThread->create(); ( aka iThread->new() )
+ * ithread->create(); ( aka ithread->new() )
  * Called in context of parent thread
  */
 
@@ -384,7 +384,7 @@ Perl_ithread_create(pTHX_ SV *obj, char* classname, SV* init_function, SV* param
 	SV**            tmps_tmp = PL_tmps_stack;
 	I32             tmps_ix  = PL_tmps_ix;
 
-	PERL_THREAD_GETSPECIFIC(self_key,current_thread);
+	PERL_THREAD_GETSPECIFIC_THREAD(self_key, current_thread);
 	MUTEX_LOCK(&create_destruct_mutex);
 	thread = PerlMemShared_malloc(sizeof(ithread));
 	Zero(thread,1,ithread);
@@ -500,13 +500,13 @@ Perl_ithread_create(pTHX_ SV *obj, char* classname, SV* init_function, SV* param
 #  endif
 #  ifdef THREAD_CREATE_NEEDS_STACK
 	    if(pthread_attr_setstacksize(&attr, THREAD_CREATE_NEEDS_STACK))
-	      croak("panic: pthread_attr_setstacksize failed");
+	      Perl_croak(aTHX_ "panic: pthread_attr_setstacksize failed");
 #  endif
 
 #ifdef OLD_PTHREADS_API
 	  pthread_create( &thread->thr, attr, Perl_ithread_run, (void *)thread);
 #else
-#  ifdef PTHREAD_SCOPE_SYSTEM
+#  if defined(HAS_PTHREAD_ATTR_SETSCOPE) && defined(PTHREAD_SCOPE_SYSTEM)
 	  pthread_attr_setscope( &attr, PTHREAD_SCOPE_SYSTEM );
 #  endif
 	  pthread_create( &thread->thr, &attr, Perl_ithread_run, (void *)thread);
@@ -524,15 +524,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
-    return ithread_to_SV(aTHX_ obj, thread, Class, TRUE);
+   ithread *thread;
+   PERL_THREAD_GETSPECIFIC_THREAD(self_key, thread);
+   if (thread)
+	return ithread_to_SV(aTHX_ obj, thread, Class, TRUE);
+   else
+	Perl_croak(aTHX_ "panic: cannot find thread data");
 }
 
 /*
@@ -589,7 +586,7 @@ 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(self_key,current_thread);
+	  PERL_THREAD_GETSPECIFIC_THREAD(self_key, current_thread);
 	  PERL_THREAD_SETSPECIFIC(self_key,thread);
 
 #if 0
@@ -618,7 +615,7 @@ Perl_ithread_join(pTHX_ SV *obj)
 	  PL_ptr_table = NULL;
 
 	}
-	/* We have finished with it */
+	/* We are finished with it */
 	thread->state |= PERL_ITHR_JOINED;
 	MUTEX_UNLOCK(&thread->mutex);
     	
@@ -666,7 +663,7 @@ PPCODE:
   MUTEX_LOCK(&create_destruct_mutex);
   curr_thread = threads;
   if(curr_thread->tid != 0)	
-    PUSHs( sv_2mortal(ithread_to_SV(aTHX_ NULL, curr_thread, classname, TRUE)));
+    XPUSHs( sv_2mortal(ithread_to_SV(aTHX_ NULL, curr_thread, classname, TRUE)));
   while(curr_thread) {
     curr_thread = curr_thread->next;
     if(curr_thread == threads)
@@ -674,7 +671,7 @@ PPCODE:
     if(curr_thread->state & PERL_ITHR_DETACHED ||
        curr_thread->state & PERL_ITHR_JOINED)
          continue;
-     PUSHs( sv_2mortal(ithread_to_SV(aTHX_ NULL, curr_thread, classname, TRUE)));
+     XPUSHs( sv_2mortal(ithread_to_SV(aTHX_ NULL, curr_thread, classname, TRUE)));
   }	
   MUTEX_UNLOCK(&create_destruct_mutex);
 }
@@ -739,11 +736,11 @@ BOOT:
 	thread->next = thread;
         thread->prev = thread;
 	thread->interp = aTHX;
-	thread->count  = 1;  /* imortal */
+	thread->count  = 1;  /* Immortal. */
 	thread->tid = tid_counter++;
 	known_threads++;
 	active_threads++;
-	thread->state = 1;
+	thread->state = PERL_ITHR_DETACHED;
 #ifdef WIN32
 	thread->thr = GetCurrentThreadId();
 #else