From: Nick Ing-Simmons <nik@tiuk.ti.com>
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) \