Change pp_lock to take a reference instead of a

[p5sagit/p5-mst-13.2.git] / ext / threads / threads.xs

diff --git a/ext/threads/threads.xs b/ext/threads/threads.xs
index db76082..5bcf4e4 100755 (executable)
--- a/ext/threads/threads.xs
+++ b/ext/threads/threads.xs
@@ -76,6 +76,7 @@ ithread *threads;
 #define ithread_CLONE(thread)          Perl_ithread_CLONE(aTHX_ thread)
 #define ithread_detach(thread)         Perl_ithread_detach(aTHX_ thread)
 #define ithread_tid(thread)            ((thread)->tid)
+#define ithread_yield(thread)          (YIELD);
 
 static perl_mutex create_destruct_mutex;  /* protects the creation and destruction of threads*/
 
@@ -90,6 +91,7 @@ perl_key self_key;
 void
 Perl_ithread_destruct (pTHX_ ithread* thread, const char *why)
 {
+        PerlInterpreter* destroyperl = NULL;        
        MUTEX_LOCK(&thread->mutex);
        if (!thread->next) {
            Perl_croak(aTHX_ "panic: destruct destroyed thread %p (%s)",thread, why);
@@ -105,8 +107,8 @@ Perl_ithread_destruct (pTHX_ ithread* thread, const char *why)
            threads = NULL;
         }
        else {
-           thread->next->prev = thread->prev->next;
-           thread->prev->next = thread->next->prev;
+           thread->next->prev = thread->prev;
+           thread->prev->next = thread->next;
            if (threads == thread) {
                threads = thread->next;
            }
@@ -122,13 +124,21 @@ Perl_ithread_destruct (pTHX_ ithread* thread, const char *why)
        MUTEX_UNLOCK(&create_destruct_mutex);
        /* Thread is now disowned */
        if (thread->interp) {
+           dTHXa(thread->interp);
            PERL_SET_CONTEXT(thread->interp);
-           perl_destruct(thread->interp);
-           perl_free(thread->interp);
+           SvREFCNT_dec(thread->params);
+           thread->params = Nullsv;
+           destroyperl = thread->interp;
            thread->interp = NULL;
        }
-       PERL_SET_CONTEXT(aTHX);
        MUTEX_UNLOCK(&thread->mutex);
+       MUTEX_DESTROY(&thread->mutex);
+        PerlMemShared_free(thread);
+       if(destroyperl) {
+           perl_destruct(destroyperl);
+            perl_free(destroyperl);
+       }
+       PERL_SET_CONTEXT(aTHX);
 }
 
 int
@@ -137,7 +147,8 @@ Perl_ithread_hook(pTHX)
     int veto_cleanup = 0;
     MUTEX_LOCK(&create_destruct_mutex);
     if (aTHX == PL_curinterp && active_threads != 1) {
-       Perl_warn(aTHX_ "Cleanup skipped %d active threads", active_threads);
+       Perl_warn(aTHX_ "A thread exited while %" IVdf " other threads were still running",
+                                               (IV)active_threads);
        veto_cleanup = 1;
     }
     MUTEX_UNLOCK(&create_destruct_mutex);
@@ -185,11 +196,16 @@ ithread_mg_free(pTHX_ SV *sv, MAGIC *mg)
     MUTEX_LOCK(&thread->mutex);
     thread->count--;
     if (thread->count == 0) {
-       if (!(thread->state & (PERL_ITHR_DETACHED|PERL_ITHR_JOINED))) {
-           Perl_warn(aTHX_ "Implicit detach");
-       }
-       MUTEX_UNLOCK(&thread->mutex);
-       Perl_ithread_detach(aTHX_ thread);
+       if(thread->state & PERL_ITHR_FINISHED &&
+          (thread->state & PERL_ITHR_DETACHED ||
+           thread->state & PERL_ITHR_JOINED))
+       {
+            MUTEX_UNLOCK(&thread->mutex);
+            Perl_ithread_destruct(aTHX_ thread, "no reference");
+       }
+       else {
+           MUTEX_UNLOCK(&thread->mutex);
+       }    
     }
     else {
        MUTEX_UNLOCK(&thread->mutex);
@@ -268,7 +284,7 @@ Perl_ithread_run(void * arg) {
                }
                PUTBACK;
                if (SvTRUE(ERRSV)) {
-                   Perl_warn(aTHX_ "Died:%_",ERRSV);
+                   Perl_warn(aTHX_ "thread failed to start: %" SVf, ERRSV);
                }
                FREETMPS;
                LEAVE;
@@ -276,21 +292,20 @@ Perl_ithread_run(void * arg) {
        }
 
        PerlIO_flush((PerlIO*)NULL);
-       MUTEX_LOCK(&create_destruct_mutex);
-       active_threads--;
-       assert( active_threads >= 0 );
-       MUTEX_UNLOCK(&create_destruct_mutex);
        MUTEX_LOCK(&thread->mutex);
        thread->state |= PERL_ITHR_FINISHED;
 
        if (thread->state & PERL_ITHR_DETACHED) {
                MUTEX_UNLOCK(&thread->mutex);
-               SvREFCNT_dec(thread->params);
-               thread->params = Nullsv;
                Perl_ithread_destruct(aTHX_ thread, "detached finish");
        } else {
                MUTEX_UNLOCK(&thread->mutex);
        }
+       MUTEX_LOCK(&create_destruct_mutex);
+       active_threads--;
+       assert( active_threads >= 0 );
+       MUTEX_UNLOCK(&create_destruct_mutex);
+
 #ifdef WIN32
        return (DWORD)0;
 #else
@@ -349,6 +364,7 @@ Perl_ithread_create(pTHX_ SV *obj, char* classname, SV* init_function, SV* param
        Zero(thread,1,ithread);
        thread->next = threads;
        thread->prev = threads->prev;
+       threads->prev = thread;
        thread->prev->next = thread;
        /* Set count to 1 immediately in case thread exits before
         * we return to caller !
@@ -357,7 +373,6 @@ Perl_ithread_create(pTHX_ SV *obj, char* classname, SV* init_function, SV* param
        MUTEX_INIT(&thread->mutex);
        thread->tid = tid_counter++;
        thread->gimme = GIMME_V;
-       thread->state = (thread->gimme == G_VOID) ? 1 : 0;
 
        /* "Clone" our interpreter into the thread's interpreter
         * This gives thread access to "static data" and code.
@@ -371,7 +386,7 @@ Perl_ithread_create(pTHX_ SV *obj, char* classname, SV* init_function, SV* param
        thread->interp = perl_clone(aTHX, CLONEf_KEEP_PTR_TABLE);
 #endif
        /* perl_clone leaves us in new interpreter's context.
-          As it is tricky to spot implcit aTHX create a new scope
+          As it is tricky to spot an implicit aTHX, create a new scope
           with aTHX matching the context for the duration of
           our work for new interpreter.
         */
@@ -393,6 +408,7 @@ Perl_ithread_create(pTHX_ SV *obj, char* classname, SV* init_function, SV* param
            SvTEMP_off(thread->init_function);
            ptr_table_free(PL_ptr_table);
            PL_ptr_table = NULL;
+           PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
        }
 
        PERL_SET_CONTEXT(aTHX);
@@ -431,6 +447,7 @@ Perl_ithread_create(pTHX_ SV *obj, char* classname, SV* init_function, SV* param
        known_threads++;
        active_threads++;
        MUTEX_UNLOCK(&create_destruct_mutex);
+       sv_2mortal(params);
        return ithread_to_SV(aTHX_ obj, thread, classname, FALSE);
 }
 
@@ -456,7 +473,7 @@ Perl_ithread_CLONE(pTHX_ SV *obj)
   }
  else
   {
-   Perl_warn(aTHX_ "CLONE %_",obj);
+   Perl_warn(aTHX_ "CLONE %" SVf,obj);
   }
 }
 
@@ -504,8 +521,7 @@ Perl_ithread_join(pTHX_ SV *obj)
        /* We have finished with it */
        thread->state |= PERL_ITHR_JOINED;
        MUTEX_UNLOCK(&thread->mutex);
-       sv_unmagic(SvRV(obj),PERL_MAGIC_shared_scalar);
-       Perl_ithread_destruct(aTHX_ thread, "joined");
+       sv_unmagic(SvRV(obj),PERL_MAGIC_shared_scalar);
        return retparam;
     }
     return (AV*)NULL;
@@ -535,7 +551,7 @@ CODE:
     if (items > 2) {
        int i;
        for(i = 2; i < items ; i++) {
-           av_push(params, ST(i));
+           av_push(params, SvREFCNT_inc(ST(i)));
        }
     }
     ST(0) = sv_2mortal(Perl_ithread_create(aTHX_ Nullsv, classname, function_to_call, newRV_noinc((SV*) params)));
@@ -543,6 +559,28 @@ CODE:
 }
 
 void
+ithread_list(char *classname)
+PPCODE:
+{
+  ithread *curr_thread;
+  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)));
+  while(curr_thread) {
+    curr_thread = curr_thread->next;
+    if(curr_thread == threads)
+      break;
+    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)));
+  }    
+  MUTEX_UNLOCK(&create_destruct_mutex);
+}
+
+
+void
 ithread_self(char *classname)
 CODE:
 {
@@ -561,11 +599,20 @@ PPCODE:
   int i;
   I32 len = AvFILL(params);
   for (i = 0; i <= len; i++) {
-    XPUSHs(av_shift(params));
+    SV* tmp = av_shift(params);
+    XPUSHs(tmp);
+    sv_2mortal(tmp);
   }
   SvREFCNT_dec(params);
 }
 
+void
+yield(...)
+CODE:
+{
+    YIELD;
+}
+       
 
 void
 ithread_detach(ithread *thread)