SvTEMP_off to stop private PV's being stolen and stored in shared space

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

diff --git a/ext/threads/threads.xs b/ext/threads/threads.xs
index 1b89e2c..4f113af 100755 (executable)
--- a/ext/threads/threads.xs
+++ b/ext/threads/threads.xs
@@ -49,6 +49,7 @@ typedef struct ithread_s {
     perl_mutex mutex;          /* mutex for updating things in this struct */
     I32 count;                 /* how many SVs have a reference to us */
     signed char detached;      /* are we detached ? */
+    int gimme;                 /* Context of create */
     SV* init_function;          /* Code to run */
     SV* params;                 /* args to pass function */
 #ifdef WIN32
@@ -81,7 +82,6 @@ void
 Perl_ithread_destruct (pTHX_ ithread* thread)
 {
        MUTEX_LOCK(&thread->mutex);
-       Perl_warn(aTHX_ "destruct %d with count=%d",thread->tid,thread->count);
        if (thread->count != 0) {
                MUTEX_UNLOCK(&thread->mutex);
                return; 
@@ -102,6 +102,10 @@ Perl_ithread_destruct (pTHX_ ithread* thread)
        }
        MUTEX_UNLOCK(&create_mutex);
        /* Thread is now disowned */
+#if 0
+        Perl_warn(aTHX_ "destruct %d @ %p by %p",
+                 thread->tid,thread->interp,aTHX);
+#endif
        if (thread->interp) {
            dTHXa(thread->interp);
            PERL_SET_CONTEXT(thread->interp);
@@ -129,7 +133,6 @@ ithread_mg_free(pTHX_ SV *sv, MAGIC *mg)
 {
     ithread *thread = (ithread *) mg->mg_ptr;
     MUTEX_LOCK(&thread->mutex);
-    Perl_warn(aTHX_ "Unmagic %d with count=%d",thread->tid,thread->count);
     thread->count--;
     MUTEX_UNLOCK(&thread->mutex);
     /* This is safe as it re-checks count */
@@ -142,7 +145,6 @@ ithread_mg_dup(pTHX_ MAGIC *mg, CLONE_PARAMS *param)
 {
     ithread *thread = (ithread *) mg->mg_ptr;
     MUTEX_LOCK(&thread->mutex);
-    Perl_warn(aTHX_ "DUP %d with count=%d",thread->tid,thread->count);
     thread->count++;
     MUTEX_UNLOCK(&thread->mutex);
     return 0;
@@ -201,21 +203,30 @@ Perl_ithread_run(void * arg) {
                    XPUSHs(av_shift(params));
                }
                PUTBACK;
-               call_sv(thread->init_function, G_DISCARD|G_EVAL);
+               len = call_sv(thread->init_function, thread->gimme|G_EVAL);
                SPAGAIN;
+               for (i=len-1; i >= 0; i--) {
+                   SV *sv = POPs;
+                   av_store(params, i, SvREFCNT_inc(sv));
+               }
+               PUTBACK;
+               if (SvTRUE(ERRSV)) {
+                   Perl_warn(aTHX_ "Died:%_",ERRSV);
+               }
                FREETMPS;
                LEAVE;
-               SvREFCNT_dec(thread->params);
                SvREFCNT_dec(thread->init_function);
        }
 
        PerlIO_flush((PerlIO*)NULL);
        MUTEX_LOCK(&thread->mutex);
-       Perl_warn(aTHX_ "finished %d with count=%d",thread->tid,thread->count);
-       if (thread->detached == 1) {
+       if (thread->detached & 1) {
                MUTEX_UNLOCK(&thread->mutex);
+               SvREFCNT_dec(thread->params);
+               thread->params = Nullsv;
                Perl_ithread_destruct(aTHX_ thread);
        } else {
+               thread->detached |= 4;
                MUTEX_UNLOCK(&thread->mutex);
        }
 #ifdef WIN32
@@ -233,7 +244,6 @@ ithread_to_SV(pTHX_ SV *obj, ithread *thread, char *classname, bool inc)
     if (inc) {
        MUTEX_LOCK(&thread->mutex);
        thread->count++;
-       Perl_warn(aTHX_ "SV for %d with count=%d",thread->tid,thread->count);
        MUTEX_UNLOCK(&thread->mutex);
     }
     if (!obj)
@@ -284,7 +294,8 @@ Perl_ithread_create(pTHX_ SV *obj, char* classname, SV* init_function, SV* param
        thread->count = 1;
        MUTEX_INIT(&thread->mutex);
        thread->tid = tid_counter++;
-       thread->detached = 0;
+       thread->gimme = GIMME_V;
+       thread->detached = (thread->gimme == G_VOID) ? 1 : 0;
 
        /* "Clone" our interpreter into the thread's interpreter
         * This gives thread access to "static data" and code.
@@ -297,18 +308,26 @@ Perl_ithread_create(pTHX_ SV *obj, char* classname, SV* init_function, SV* param
 #else
        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
+          with aTHX matching the context for the duration of
+          our work for new interpreter.
+        */
+       {
+           dTHXa(thread->interp);
 
-       clone_param.flags = 0;  
-       thread->init_function = Perl_sv_dup(thread->interp, init_function, &clone_param);
-       if (SvREFCNT(thread->init_function) == 0) {
-           SvREFCNT_inc(thread->init_function);
-       }       
-
-       thread->params = Perl_sv_dup(thread->interp,params, &clone_param);
-       SvREFCNT_inc(thread->params);
-       SvTEMP_off(thread->init_function);
-       ptr_table_free(PL_ptr_table);
-       PL_ptr_table = NULL;
+            clone_param.flags = 0;     
+           thread->init_function = sv_dup(init_function, &clone_param);
+           if (SvREFCNT(thread->init_function) == 0) {
+               SvREFCNT_inc(thread->init_function);
+           }   
+
+           thread->params = sv_dup(params, &clone_param);
+           SvREFCNT_inc(thread->params);
+           SvTEMP_off(thread->init_function);
+           ptr_table_free(PL_ptr_table);
+           PL_ptr_table = NULL;
+       }
        
        PERL_SET_CONTEXT(aTHX);
 
@@ -379,8 +398,15 @@ Perl_ithread_join(pTHX_ SV *obj)
 {
     ithread *thread = SV_to_ithread(aTHX_ obj);
     MUTEX_LOCK(&thread->mutex);
-    Perl_warn(aTHX_ "joining %d with count=%d",thread->tid,thread->count);
-    if (!thread->detached) {
+    if (thread->detached & 1) {
+       MUTEX_UNLOCK(&thread->mutex);
+       Perl_croak(aTHX_ "Cannot join a detached thread");
+    }
+    else if (thread->detached & 2) {
+       MUTEX_UNLOCK(&thread->mutex);
+       Perl_croak(aTHX_ "Thread already joined");
+    }
+    else {
 #ifdef WIN32
        DWORD waitcode;
 #else
@@ -392,17 +418,13 @@ Perl_ithread_join(pTHX_ SV *obj)
 #else
        pthread_join(thread->thr,&retval);
 #endif
-       Perl_warn(aTHX_ "joined %d with count=%d",thread->tid,thread->count);
-       /* We have finished with it */
        MUTEX_LOCK(&thread->mutex);
-       thread->detached = 2;
+       /* sv_dup over the args */
+       /* We have finished with it */
+       thread->detached |= 2;
        MUTEX_UNLOCK(&thread->mutex);
        sv_unmagic(SvRV(obj),PERL_MAGIC_shared_scalar);
     }
-    else {
-       MUTEX_UNLOCK(&thread->mutex);
-       Perl_croak(aTHX_ "Cannot join a detached thread");
-    }
 }
 
 void
@@ -426,7 +448,6 @@ void
 Perl_ithread_DESTROY(pTHX_ SV *sv)
 {
     ithread *thread = SV_to_ithread(aTHX_ sv);
-    Perl_warn(aTHX_ "DESTROY %d with count=%d",thread->tid,thread->count);
     sv_unmagic(SvRV(sv),PERL_MAGIC_shared_scalar);
 }
 
@@ -470,9 +491,6 @@ ithread_detach(ithread *thread)
 void
 ithread_DESTROY(SV *thread)
 
-void
-ithread_CLONE(SV *sv)
-
 BOOT:
 {
        ithread* thread;