From: Nick Ing-Simmons Date: Sat, 8 Nov 1997 15:03:39 +0000 (+0000) Subject: Get threads working again on Win32 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=0b9678a8abcf790b88babcb35eec34072787a87f;p=p5sagit%2Fp5-mst-13.2.git Get threads working again on Win32 Root cause of fail was init_thread_intern() in new_struct_thread() (which is called in parent thread) clobbering dTHR of parent thread. It is doubtfull if setting 'self' in new_struct_thread() is 'right' but left in for now. p4raw-id: //depot/ansiperl@213 --- diff --git a/ext/Thread/Thread.xs b/ext/Thread/Thread.xs index 3a204b2..79e926c 100644 --- a/ext/Thread/Thread.xs +++ b/ext/Thread/Thread.xs @@ -89,8 +89,10 @@ threadstart(void *arg) AV *returnav; int i, ret; dJMPENV; + DEBUG_L(PerlIO_printf(PerlIO_stderr(), "new thread %p waiting to start\n", + thr)); - /* Don't call *anything* requiring dTHR until after pthread_setspecific */ + /* Don't call *anything* requiring dTHR until after SET_THR() */ /* * Wait until our creator releases us. If we didn't do this, then * it would be potentially possible for out thread to carry on and @@ -226,8 +228,8 @@ newthread (SV *startsv, AV *initargs, char *Class) thr = new_struct_thread(thr); SPAGAIN; DEBUG_L(PerlIO_printf(PerlIO_stderr(), - "%p: newthread, tid is %u, preparing stack\n", - savethread, thr->tid)); + "%p: newthread (%p), tid is %u, preparing stack\n", + savethread, thr, thr->tid)); /* The following pushes the arg list and startsv onto the *new* stack */ PUSHMARK(sp); /* Could easily speed up the following greatly */ @@ -235,7 +237,6 @@ newthread (SV *startsv, AV *initargs, char *Class) XPUSHs(SvREFCNT_inc(*av_fetch(initargs, i, FALSE))); XPUSHs(SvREFCNT_inc(startsv)); PUTBACK; - #ifdef THREAD_CREATE err = THREAD_CREATE(thr, threadstart); #else @@ -251,6 +252,8 @@ newthread (SV *startsv, AV *initargs, char *Class) MUTEX_UNLOCK(&thr->mutex); #endif if (err) { + DEBUG_L(PerlIO_printf(PerlIO_stderr(), + "%p: create of %p failed %d\n", savethread, thr, err)); /* Thread creation failed--clean up */ SvREFCNT_dec(thr->cvcache); remove_thread(thr); @@ -286,6 +289,7 @@ handle_thread_signal(int sig) } MODULE = Thread PACKAGE = Thread +PROTOTYPES: DISABLE void new(Class, startsv, ...) diff --git a/perl.c b/perl.c index 591ec83..f6cef35 100644 --- a/perl.c +++ b/perl.c @@ -128,7 +128,9 @@ perl_construct(register PerlInterpreter *sv_interp) #ifdef USE_THREADS INIT_THREADS; -#ifndef WIN32 +#ifdef ALLOC_THREAD_KEY + ALLOC_THREAD_KEY; +#else if (pthread_key_create(&thr_key, 0)) croak("panic: pthread_key_create"); #endif @@ -2829,8 +2831,8 @@ init_main_thread() thr->prev = thr; MUTEX_UNLOCK(&threads_mutex); -#ifdef HAVE_THREAD_INTERN - init_thread_intern(thr); +#ifdef INIT_THREAD_INTERN + INIT_THREAD_INTERN(thr); #else thr->self = pthread_self(); #endif /* HAVE_THREAD_INTERN */ diff --git a/thread.h b/thread.h index 2ee4f51..f18b38b 100644 --- a/thread.h +++ b/thread.h @@ -128,6 +128,7 @@ struct thread *getTHR _((void)); # endif #endif + #ifndef THREAD_RET_TYPE # define THREAD_RET_TYPE void * # define THREAD_RET_CAST(p) ((void *)(p)) @@ -223,7 +224,7 @@ struct thread { perl_mutex mutex; /* For the fields others can change */ U32 tid; struct thread *next, *prev; /* Circular linked list of threads */ - + JMPENV Tstart_env; /* Top of top_env longjmp() chain */ #ifdef ADD_THREAD_INTERN struct thread_intern i; /* Platform-dependent internals */ #endif @@ -306,6 +307,7 @@ typedef struct condpair { #undef chopset #undef formtarget #undef bodytarget +#undef start_env #undef toptarget #undef top_env #undef runlevel @@ -381,6 +383,7 @@ typedef struct condpair { #define top_env (thr->Ttop_env) #define runlevel (thr->Trunlevel) +#define start_env (thr->Tstart_env) #else /* USE_THREADS is not defined */ diff --git a/util.c b/util.c index 914ec6a..62b0f00 100644 --- a/util.c +++ b/util.c @@ -2418,8 +2418,6 @@ new_struct_thread(struct thread *t) SvGROW(sv, sizeof(struct thread) + 1); SvCUR_set(sv, sizeof(struct thread)); thr = (Thread) SvPVX(sv); - /* Zero(thr, 1, struct thread); */ - /* debug */ memset(thr, 0xab, sizeof(struct thread)); markstack = 0; @@ -2431,7 +2429,7 @@ new_struct_thread(struct thread *t) /* end debug */ thr->oursv = sv; - init_stacks(thr); + init_stacks(ARGS); curcop = &compiling; thr->cvcache = newHV(); @@ -2443,9 +2441,23 @@ new_struct_thread(struct thread *t) curcop = t->Tcurcop; /* XXX As good a guess as any? */ defstash = t->Tdefstash; /* XXX maybe these should */ curstash = t->Tcurstash; /* always be set to main? */ - /* top_env needs to be non-zero. The particular value doesn't matter */ - top_env = t->Ttop_env; - runlevel = 1; /* XXX should be safe ? */ + + + /* top_env needs to be non-zero. It points to an area + in which longjmp() stuff is stored, as C callstack + info there at least is thread specific this has to + be per-thread. Otherwise a 'die' in a thread gives + that thread the C stack of last thread to do an eval {}! + See comments in scope.h + Initialize top entry (as in perl.c for main thread) + */ + start_env.je_prev = NULL; + start_env.je_ret = -1; + start_env.je_mustcatch = TRUE; + top_env = &start_env; + + runlevel = 0; /* Let entering sub do increment */ + in_eval = FALSE; restartop = 0; @@ -2470,7 +2482,8 @@ new_struct_thread(struct thread *t) av_store(thr->magicals, i, sv); sv_magic(sv, 0, 0, &per_thread_magicals[i], 1); DEBUG_L(PerlIO_printf(PerlIO_stderr(), - "new_struct_thread: copied magical %d\n",i)); + "new_struct_thread: copied magical %d %p->%p\n",i, + t, thr)); } } @@ -2483,8 +2496,17 @@ new_struct_thread(struct thread *t) thr->next->prev = thr; MUTEX_UNLOCK(&threads_mutex); -#ifdef HAVE_THREAD_INTERN - init_thread_intern(thr); +/* + * This is highly suspect - new_struct_thread is executed + * by creating thread so pthread_self() or equivalent + * is parent thread not the child. + * In particular this should _NOT_ change dTHR value of calling thread. + * + * But a good place to have a 'hook' for filling in port-private + * fields of thr. + */ +#ifdef INIT_THREAD_INTERN + INIT_THREAD_INTERN(thr); #else thr->self = pthread_self(); #endif /* HAVE_THREAD_INTERN */ diff --git a/win32/Makefile b/win32/Makefile index 1bc08ff..7ed7cad 100644 --- a/win32/Makefile +++ b/win32/Makefile @@ -360,8 +360,8 @@ $(PERLEXE): $(PERLDLL) $(CONFIGPM) perlmain.obj del perl.exe copy splittree.pl .. $(MINIPERL) -I..\lib ..\splittree.pl "../LIB" "../LIB/auto" - attrib -r ..\t\*.* - copy test ..\t +# attrib -r ..\t\*.* +# copy test ..\t perl95.c : runperl.c copy runperl.c perl95.c diff --git a/win32/win32thread.c b/win32/win32thread.c index f93d5e3..dfa9a0c 100644 --- a/win32/win32thread.c +++ b/win32/win32thread.c @@ -2,10 +2,25 @@ #include "perl.h" void -init_thread_intern(struct thread *thr) +Perl_alloc_thread_key(void) { #ifdef USE_THREADS static int key_allocated = 0; + if (!key_allocated) { + if ((thr_key = TlsAlloc()) == TLS_OUT_OF_INDEXES) + croak("panic: TlsAlloc"); + key_allocated = 1; + } +#endif +} + +void +init_thread_intern(struct thread *thr) +{ +#ifdef USE_THREADS + /* GetCurrentThread() retrurns a pseudo handle, need + this to convert it into a handle another thread can use + */ DuplicateHandle(GetCurrentProcess(), GetCurrentThread(), GetCurrentProcess(), @@ -13,13 +28,6 @@ init_thread_intern(struct thread *thr) 0, FALSE, DUPLICATE_SAME_ACCESS); - if (!key_allocated) { - if ((thr_key = TlsAlloc()) == TLS_OUT_OF_INDEXES) - croak("panic: TlsAlloc"); - key_allocated = 1; - } - if (TlsSetValue(thr_key, (LPVOID) thr) != TRUE) - croak("panic: TlsSetValue"); #endif } @@ -30,7 +38,11 @@ Perl_thread_create(struct thread *thr, thread_func_t *fn) DWORD junk; MUTEX_LOCK(&thr->mutex); + DEBUG_L(PerlIO_printf(PerlIO_stderr(), + "%p: create OS thread\n", thr)); thr->self = CreateThread(NULL, 0, fn, (void*)thr, 0, &junk); + DEBUG_L(PerlIO_printf(PerlIO_stderr(), + "%p: OS thread = %p, id=%ld\n", thr, thr->self, junk)); MUTEX_UNLOCK(&thr->mutex); return thr->self ? 0 : -1; } diff --git a/win32/win32thread.h b/win32/win32thread.h index 697af3f..75aa25b 100644 --- a/win32/win32thread.h +++ b/win32/win32thread.h @@ -102,12 +102,16 @@ typedef HANDLE perl_mutex; typedef THREAD_RET_TYPE thread_func_t(void *); -#define HAVE_THREAD_INTERN START_EXTERN_C -void Perl_init_thread_intern _((struct thread *thr)); +void Perl_alloc_thread_key _((void)); int Perl_thread_create _((struct thread *thr, thread_func_t *fn)); +void Perl_init_thread_intern _((struct thread *thr)); END_EXTERN_C +#define INIT_THREADS NOOP +#define ALLOC_THREAD_KEY Perl_alloc_thread_key() +#define INIT_THREAD_INTERN(thr) Perl_init_thread_intern(thr) + #define JOIN(t, avp) \ STMT_START { \ if ((WaitForSingleObject((t)->self,INFINITE) == WAIT_FAILED) \