From: Nick Ing-Simmons Date: Sun, 20 Jan 2002 11:50:22 +0000 (+0000) Subject: threads work again on Win32. (Not threads::shared yet) X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=ba14dd9ace5a84c9784d70e7ae3b0baccfea783d;p=p5sagit%2Fp5-mst-13.2.git 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 --- 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 --- 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 --- 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 #----------------------------------------------------------------------------------