threads work again on Win32. (Not threads::shared yet)

Submit to see if they do on Linux.

p4raw-id: //depot/perlio@14355

diff --git a/ext/threads/shared/shared.xs b/ext/threads/shared/shared.xs
index e21bbe9..876fb97 100644 (file)
--- a/ext/threads/shared/shared.xs
+++ b/ext/threads/shared/shared.xs
@@ -280,6 +280,8 @@ Perl_sharedsv_thrcnt_dec(pTHX_ shared_sv* ssv)
 
 MGVTBL svtable;
 
+#define shared_sv_attach_sv(sv,shared) Perl_shared_sv_attach_sv(aTHX_ sv,shared)
+
 SV* Perl_shared_sv_attach_sv (pTHX_ SV* sv, shared_sv* shared) {
     HV* shared_hv = get_hv("threads::shared::shared", FALSE);
     SV* id = newSViv(PTR2IV(shared));
@@ -393,17 +395,18 @@ int shared_sv_store_mg (pTHX_ SV* sv, MAGIC *mg) {
     return 0;
 }
 
-int shared_sv_destroy_mg (pTHX_ SV* sv, MAGIC *mg) {
+int 
+shared_sv_destroy_mg (pTHX_ SV* sv, MAGIC *mg) 
+{
     shared_sv* shared = INT2PTR(shared_sv*, SvIV(mg->mg_obj));
-    if(!shared)
-        return 0;
-    {
+    if (shared) {
        HV* shared_hv = get_hv("threads::shared::shared", FALSE);
         SV* id = newSViv(PTR2IV(shared));
         STRLEN length = sv_len(id);
         hv_delete(shared_hv, SvPV(id,length), length,0);
+       Perl_sharedsv_thrcnt_dec(aTHX_ shared);
     }
-    Perl_sharedsv_thrcnt_dec(aTHX_ shared);
+    return 0;
 }
 
 MGVTBL svtable = {MEMBER_TO_FPTR(shared_sv_fetch_mg),

diff --git a/ext/threads/threads.xs b/ext/threads/threads.xs
index 1b89e2c..82989b9 100755 (executable)
--- a/ext/threads/threads.xs
+++ b/ext/threads/threads.xs
@@ -81,7 +81,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 +101,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 +132,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 +144,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;
@@ -211,7 +212,6 @@ Perl_ithread_run(void * arg) {
 
        PerlIO_flush((PerlIO*)NULL);
        MUTEX_LOCK(&thread->mutex);
-       Perl_warn(aTHX_ "finished %d with count=%d",thread->tid,thread->count);
        if (thread->detached == 1) {
                MUTEX_UNLOCK(&thread->mutex);
                Perl_ithread_destruct(aTHX_ thread);
@@ -233,7 +233,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)
@@ -297,18 +296,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,7 +386,6 @@ 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) {
 #ifdef WIN32
        DWORD waitcode;
@@ -392,7 +398,6 @@ 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;
@@ -426,7 +431,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 +474,6 @@ ithread_detach(ithread *thread)
 void
 ithread_DESTROY(SV *thread)
 
-void
-ithread_CLONE(SV *sv)
-
 BOOT:
 {
        ithread* thread;

diff --git a/win32/makefile.mk b/win32/makefile.mk
index 8cafd27..b7f7566 100644 (file)
--- a/win32/makefile.mk
+++ b/win32/makefile.mk
@@ -335,7 +335,7 @@ RSC         = rc
 # Options
 #
 INCLUDES       = -I$(COREDIR) -I.\include -I. -I.. -I"$(CCINCDIR)"
-#PCHFLAGS      = -H -Hc -H=c:\temp\bcmoduls.pch 
+#PCHFLAGS      = -H -Hc -H=c:\temp\bcmoduls.pch
 DEFINES                = -DWIN32 $(CRYPT_FLAG)
 LOCDEFS                = -DPERLDLL -DPERL_CORE
 SUBSYS         = console
@@ -647,7 +647,6 @@ MICROCORE_SRC       =               \
                ..\run.c        \
                ..\scope.c      \
                ..\sv.c         \
-               ..\sharedsv.c   \
                ..\taint.c      \
                ..\toke.c       \
                ..\universal.c  \
@@ -709,7 +708,6 @@ CORE_NOCFG_H        =               \
                ..\proto.h      \
                ..\regexp.h     \
                ..\scope.h      \
-               ..\sharedsv.h   \
                ..\sv.h         \
                ..\thread.h     \
                ..\unixish.h    \
@@ -732,7 +730,7 @@ MICROCORE_OBJ       = $(MICROCORE_SRC:db:+$(o))
 CORE_OBJ       = $(MICROCORE_OBJ) $(EXTRACORE_SRC:db:+$(o))
 WIN32_OBJ      = $(WIN32_SRC:db:+$(o))
 MINICORE_OBJ   = $(MINIDIR)\{$(MICROCORE_OBJ:f) miniperlmain$(o) perlio$(o)}
-MINIWIN32_OBJ  = $(MINIDIR)\{$(WIN32_OBJ:f)} 
+MINIWIN32_OBJ  = $(MINIDIR)\{$(WIN32_OBJ:f)}
 MINI_OBJ       = $(MINICORE_OBJ) $(MINIWIN32_OBJ)
 DLL_OBJ                = $(DLL_SRC:db:+$(o))
 X2P_OBJ                = $(X2P_SRC:db:+$(o))
@@ -813,7 +811,7 @@ RIGHTMAKE   =
 
 all : .\config.h $(GLOBEXE) $(MINIPERL) $(MK2)         \
        $(RIGHTMAKE) $(MINIMOD) $(CONFIGPM) $(PERLEXE)  \
-       $(X2P) Extensions 
+       $(X2P) Extensions
 
 $(DYNALOADER)$(o) : $(DYNALOADER).c $(CORE_H) $(EXTDIR)\DynaLoader\dlutils.c
 
@@ -1055,10 +1053,10 @@ $(EXTDIR)\DynaLoader\dl_win32.xs: dl_win32.xs
        copy dl_win32.xs $(EXTDIR)\DynaLoader\dl_win32.xs
 
 #----------------------------------------------------------------------------------
-Extensions : buildext.pl $(PERLDEP) $(CONFIGPM) 
+Extensions : buildext.pl $(PERLDEP) $(CONFIGPM)
        $(MINIPERL) -I..\lib buildext.pl $(MAKE) $(PERLDEP) $(EXTDIR)
 
-Extensions_clean : 
+Extensions_clean :
        -if exist $(MINIPERL) $(MINIPERL) -I..\lib buildext.pl $(MAKE) $(PERLDEP) $(EXTDIR) clean
 
 #----------------------------------------------------------------------------------