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

diff --git a/ext/threads/threads.xs b/ext/threads/threads.xs
index 0110724..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.h: TlsAlloc");\
+    PerlIO_printf(PerlIO_stderr(), "panic threads.xs: TlsAlloc");\
     exit(1);\
   }\
 } STMT_END
@@ -31,7 +31,7 @@ typedef perl_os_thread pthread_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.h: pthread_key_create");\
+    PerlIO_printf(PerlIO_stderr(), "panic threads.xs: pthread_key_create");\
     exit(1);\
   }\
 } STMT_END
@@ -40,12 +40,17 @@ typedef perl_os_thread pthread_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.h: pthread_key_create");\
+    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
 
 /* 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);
 
 
@@ -356,13 +364,13 @@ SV_to_ithread(pTHX_ SV *sv)
      }
     else
      {
-      PERL_THREAD_GETSPECIFIC(self_key,thread);
+      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
  */
 
@@ -376,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);
@@ -399,7 +407,10 @@ Perl_ithread_create(pTHX_ SV *obj, char* classname, SV* init_function, SV* param
 	PerlIO_flush((PerlIO*)NULL);
 	PERL_THREAD_SETSPECIFIC(self_key,thread);
 
-
+	SAVEBOOL(PL_srand_called); /* Save this so it becomes the correct
+	                              value */
+	PL_srand_called = FALSE; /* Set it to false so we can detect
+	                            if it gets set during the clone */
 
 #ifdef WIN32
 	thread->interp = perl_clone(aTHX, CLONEf_KEEP_PTR_TABLE | CLONEf_CLONE_HOST);
@@ -413,6 +424,7 @@ Perl_ithread_create(pTHX_ SV *obj, char* classname, SV* init_function, SV* param
 	 */
 	{
 	    dTHXa(thread->interp);
+
             /* Here we remove END blocks since they should only run
 	       in the thread they are created
             */
@@ -488,12 +500,15 @@ 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
+#  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);
 #endif
 	}
@@ -509,9 +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;
-    PERL_THREAD_GETSPECIFIC(self_key,thread);
-    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");
 }
 
 /*
@@ -568,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
@@ -597,10 +615,10 @@ 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);
-    	sv_unmagic(SvRV(obj),PERL_MAGIC_shared_scalar);
+    	
 	return retparam;
     }
     return (AV*)NULL;
@@ -645,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)
@@ -653,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);
 }
@@ -718,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