to use new API and patch win32 makefile stuff a little.
p4raw-id: //depot/perl@172
Merging
- 5.004_04
oneperl (THIS pointer)
Multi-threading
- Fix Thread->list
$AUTOLOAD. Hmm.
without USE_THREADS, change extern variable for dTHR
consistent semantics for exit/die in threads
SvREFCNT_dec(curstack) in threadstart() in Thread.xs
$@ and other magic globals:
- global lexical pool with auto-binding for magicals
+ global pseudo-lexical pad with auto-binding for magicals
move magicals that should be per-thread into thread.h
- sv_magic for the necessary global lexical pool entries
+ sv_magic for the necessary global pad entries
Thread::Pool
- check new condition variable word; fix cond.t
more Configure support
Miscellaneous
rename and alter ISA.pm
+ magic_setisa should be made to update %FIELDS
Compiler
auto-produce executable
MUTEX_UNLOCK(&threads_mutex);
}
-static void *
+static THREAD_RET_TYPE
threadstart(arg)
void *arg;
{
* 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
* do stuff before our creator fills in our "self" field. For example,
- * if we went and created another thread which tried to pthread_join
- * with us, then we'd be in a mess.
+ * if we went and created another thread which tried to JOIN with us,
+ * then we'd be in a mess.
*/
MUTEX_LOCK(&thr->mutex);
MUTEX_UNLOCK(&thr->mutex);
* from our pthread_t structure to our struct thread, since we're
* the only thread who can get at it anyway.
*/
- if (pthread_setspecific(thr_key, (void *) thr))
- croak("panic: pthread_setspecific");
+ SET_THR(thr);
/* Only now can we use SvPEEK (which calls sv_newmortal which does dTHR) */
DEBUG_L(PerlIO_printf(PerlIO_stderr(), "new thread %p starting at %s\n",
croak("panic: illegal state %u at end of threadstart", ThrSTATE(thr));
/* NOTREACHED */
}
- return (void *) returnav; /* Available for anyone to join with us */
- /* unless we are detached in which case */
- /* noone will see the value anyway. */
+ return THREAD_RET_CAST(returnav); /* Available for anyone to join with */
+ /* us unless we're detached, in which */
+ /* case noone sees the value anyway. */
#endif
}
Thread savethread;
int i;
SV *sv;
+ int err;
+#ifndef THREAD_CREATE
sigset_t fullmask, oldmask;
+#endif
savethread = thr;
sv = newSVpv("", 0);
XPUSHs(SvREFCNT_inc(startsv));
PUTBACK;
-#ifdef FAKE_THREADS
- threadstart(thr);
+#ifdef THREAD_CREATE
+ THREAD_CREATE(thr, threadstart);
#else
/* On your marks... */
MUTEX_LOCK(&thr->mutex);
- /* Get set...
- * Increment the global thread count.
- */
+ /* Get set... */
sigfillset(&fullmask);
if (sigprocmask(SIG_SETMASK, &fullmask, &oldmask) == -1)
croak("panic: sigprocmask");
- if (pthread_create(&self, NULL, threadstart, (void*) thr))
- return NULL; /* XXX should clean up first */
+ err = pthread_create(&self, pthread_attr_default, threadstart, (void*) thr);
/* Go */
MUTEX_UNLOCK(&thr->mutex);
+#endif
+ if (err) {
+ /* Thread creation failed--clean up */
+ SvREFCNT_dec(cvcache);
+ remove_thread(thr);
+ MUTEX_DESTROY(&thr->mutex);
+ for (i = 0; i <= AvFILL(initargs); i++)
+ SvREFCNT_dec(*av_fetch(initargs, i, FALSE));
+ SvREFCNT_dec(startsv);
+ return NULL;
+ }
+#ifdef THREAD_POST_CREATE
+ THREAD_POST_CREATE(thr);
+#else
if (sigprocmask(SIG_SETMASK, &oldmask, 0))
croak("panic: sigprocmask");
#endif
croak("can't join with thread");
/* NOTREACHED */
}
- if (pthread_join(t->Tself, (void **) &av))
- croak("pthread_join failed");
+ JOIN(t, &av);
/* Could easily speed up the following if necessary */
for (i = 0; i <= AvFILL(av); i++)
void
yield()
CODE:
-#ifdef OLD_PTHREADS_API
- pthread_yield();
-#else
-#ifndef NO_SCHED_YIELD
- sched_yield();
-#endif /* NO_SCHED_YIELD */
-#endif /* OLD_PTHREADS_API */
+ YIELD;
void
cond_wait(sv)
await_signal()
PREINIT:
char c;
- ssize_t ret;
+ SSize_t ret;
CODE:
do {
ret = read(sig_pipe[1], &c, 1);
typedef int perl_mutex;
typedef int perl_key;
+typedef struct thread *perl_thread;
+/* With fake threads, thr is global(ish) so we don't need dTHR */
+#define dTHR extern int errno
+
struct perl_wait_queue {
struct thread * thread;
struct perl_wait_queue * next;
(t)->i.private = 0; \
} STMT_END
+/*
+ * Note that SCHEDULE() is only callable from pp code (which
+ * must be expecting to be restarted). We'll have to do
+ * something a bit different for XS code.
+ */
+
+#define SCHEDULE() return schedule(), op
+
+#define MUTEX_LOCK(m)
+#define MUTEX_UNLOCK(m)
+#define MUTEX_INIT(m)
+#define MUTEX_DESTROY(m)
+#define COND_INIT(c) perl_cond_init(c)
+#define COND_SIGNAL(c) perl_cond_signal(c)
+#define COND_BROADCAST(c) perl_cond_broadcast(c)
+#define COND_WAIT(c, m) \
+ STMT_START { \
+ perl_cond_wait(c); \
+ SCHEDULE(); \
+ } STMT_END
+#define COND_DESTROY(c)
+
+#define THREAD_CREATE(t, f) f((t))
+#define THREAD_POST_CREATE(t) NOOP
+
+#define YIELD NOOP
gt_amg
hexdigit
hints
+init_thread_intern
in_my
in_my_stash
inc_amg
nomemok
nomethod_amg
not_amg
+nthreads
numeric_local
numeric_name
numeric_standard
sv_undef
sv_yes
thisexpr
+thr_key
timesbuf
tokenbuf
uid
if (strEQ(name, "OVERLOAD")) {
HV* hv = GvHVn(gv);
GvMULTI_on(gv);
- sv_magic((SV*)hv, (SV*)gv, 'A', 0, 0);
+ hv_magic(hv, gv, 'A');
}
break;
#endif /* OVERLOAD */
XPV *xpv;
INIT_THREADS;
- New(53, thr, 1, struct thread);
+ Newz(53, thr, 1, struct thread);
MUTEX_INIT(&malloc_mutex);
MUTEX_INIT(&sv_mutex);
/* Safe to use SVs from now on */
self = pthread_self();
if (pthread_key_create(&thr_key, 0))
croak("panic: pthread_key_create");
- if (pthread_setspecific(thr_key, (void *) thr))
- croak("panic: pthread_setspecific");
-#endif /* FAKE_THREADS */
+#endif /* HAVE_THREAD_INTERN */
+ SET_THR(thr);
#endif /* USE_THREADS */
linestr = NEWSV(65,80);
* all over again.
*/
MUTEX_UNLOCK(&threads_mutex);
- if (pthread_join(t->Tself, (void**)&av))
- croak("panic: pthread_join failed during global destruction");
+ JOIN(t, &av);
SvREFCNT_dec((SV*)av);
DEBUG_L(PerlIO_printf(PerlIO_stderr(),
"perl_destruct: joined zombie %p OK\n", t));
*/
#ifdef DOSUID
+ dTHR;
char *s, *s2;
if (Fstat(PerlIO_fileno(rsfp),&statbuf) < 0) /* normal stat is insecure */
#define NOOP (void)0
#define WITH_THR(s) do { dTHR; s; } while (0)
+
#ifdef USE_THREADS
-#ifdef FAKE_THREADS
-#include "fakethr.h"
-#else
-#include <pthread.h>
+# ifdef FAKE_THREADS
+# include "fakethr.h"
+# else
+# ifdef WIN32
+# include "win32/win32thread.h"
+# else
+# include <pthread.h>
typedef pthread_mutex_t perl_mutex;
typedef pthread_cond_t perl_cond;
typedef pthread_key_t perl_key;
-#endif /* FAKE_THREADS */
+# endif /* WIN32 */
+# endif /* FAKE_THREADS */
#endif /* USE_THREADS */
/*
-#ifndef USE_THREADS
-#define MUTEX_LOCK(m)
-#define MUTEX_UNLOCK(m)
-#define MUTEX_INIT(m)
-#define MUTEX_DESTROY(m)
-#define COND_INIT(c)
-#define COND_SIGNAL(c)
-#define COND_BROADCAST(c)
-#define COND_WAIT(c, m)
-#define COND_DESTROY(c)
-
-#define THR
-/* Rats: if dTHR is just blank then the subsequent ";" throws an error */
-#define dTHR extern int errno
-#else
-
-#ifdef FAKE_THREADS
-typedef struct thread *perl_thread;
-/* With fake threads, thr is global(ish) so we don't need dTHR */
-#define dTHR extern int errno
+#ifdef USE_THREADS
-/*
- * Note that SCHEDULE() is only callable from pp code (which
- * must be expecting to be restarted). We'll have to do
- * something a bit different for XS code.
- */
-#define SCHEDULE() return schedule(), op
+#ifdef WIN32
+# include "win32/win32thread.h"
+#endif
-#define MUTEX_LOCK(m)
-#define MUTEX_UNLOCK(m)
-#define MUTEX_INIT(m)
-#define MUTEX_DESTROY(m)
-#define COND_INIT(c) perl_cond_init(c)
-#define COND_SIGNAL(c) perl_cond_signal(c)
-#define COND_BROADCAST(c) perl_cond_broadcast(c)
-#define COND_WAIT(c, m) STMT_START { \
- perl_cond_wait(c); \
- SCHEDULE(); \
- } STMT_END
-#define COND_DESTROY(c)
-#else
/* POSIXish threads */
typedef pthread_t perl_thread;
#ifdef OLD_PTHREADS_API
-#define pthread_mutexattr_init(a) pthread_mutexattr_create(a)
-#define pthread_mutexattr_settype(a,t) pthread_mutexattr_setkind_np(a,t)
-#define pthread_key_create(k,d) pthread_keycreate(k,(pthread_destructor_t)(d))
+# define pthread_mutexattr_init(a) pthread_mutexattr_create(a)
+# define pthread_mutexattr_settype(a,t) pthread_mutexattr_setkind_np(a,t)
+# define pthread_key_create(k,d) pthread_keycreate(k,(pthread_destructor_t)(d))
+# define YIELD pthread_yield()
+# define DETACH(t) \
+ STMT_START { \
+ if (pthread_detach(&(t)->Tself)) { \
+ MUTEX_UNLOCK(&(t)->mutex); \
+ croak("panic: DETACH"); \
+ } \
+ } STMT_END
#else
-#define pthread_mutexattr_default NULL
-#define pthread_condattr_default NULL
+# define pthread_mutexattr_default NULL
+# define pthread_condattr_default NULL
+# define pthread_attr_default NULL
#endif /* OLD_PTHREADS_API */
-#define MUTEX_INIT(m) \
- if (pthread_mutex_init((m), pthread_mutexattr_default)) \
- croak("panic: MUTEX_INIT"); \
- else 1
-#define MUTEX_LOCK(m) \
- if (pthread_mutex_lock((m))) croak("panic: MUTEX_LOCK"); else 1
-#define MUTEX_UNLOCK(m) \
- if (pthread_mutex_unlock((m))) croak("panic: MUTEX_UNLOCK"); else 1
-#define MUTEX_DESTROY(m) \
- if (pthread_mutex_destroy((m))) croak("panic: MUTEX_DESTROY"); else 1
-#define COND_INIT(c) \
- if (pthread_cond_init((c), pthread_condattr_default)) \
- croak("panic: COND_INIT"); \
- else 1
-#define COND_SIGNAL(c) \
- if (pthread_cond_signal((c))) croak("panic: COND_SIGNAL"); else 1
-#define COND_BROADCAST(c) \
- if (pthread_cond_broadcast((c))) croak("panic: COND_BROADCAST"); else 1
-#define COND_WAIT(c, m) \
- if (pthread_cond_wait((c), (m))) croak("panic: COND_WAIT"); else 1
-#define COND_DESTROY(c) \
- if (pthread_cond_destroy((c))) croak("panic: COND_DESTROY"); else 1
+#ifndef YIELD
+# define YIELD sched_yield()
+#endif
+
+#ifndef MUTEX_INIT
+#define MUTEX_INIT(m) \
+ STMT_START { \
+ if (pthread_mutex_init((m), pthread_mutexattr_default)) \
+ croak("panic: MUTEX_INIT"); \
+ } STMT_END
+#define MUTEX_LOCK(m) \
+ STMT_START { \
+ if (pthread_mutex_lock((m))) \
+ croak("panic: MUTEX_LOCK"); \
+ } STMT_END
+#define MUTEX_UNLOCK(m) \
+ STMT_START { \
+ if (pthread_mutex_unlock((m))) \
+ croak("panic: MUTEX_UNLOCK"); \
+ } STMT_END
+#define MUTEX_DESTROY(m) \
+ STMT_START { \
+ if (pthread_mutex_destroy((m))) \
+ croak("panic: MUTEX_DESTROY"); \
+ } STMT_END
+#endif /* MUTEX_INIT */
+
+#ifndef COND_INIT
+#define COND_INIT(c) \
+ STMT_START { \
+ if (pthread_cond_init((c), pthread_condattr_default)) \
+ croak("panic: COND_INIT"); \
+ } STMT_END
+#define COND_SIGNAL(c) \
+ STMT_START { \
+ if (pthread_cond_signal((c))) \
+ croak("panic: COND_SIGNAL"); \
+ } STMT_END
+#define COND_BROADCAST(c) \
+ STMT_START { \
+ if (pthread_cond_broadcast((c))) \
+ croak("panic: COND_BROADCAST"); \
+ } STMT_END
+#define COND_WAIT(c, m) \
+ STMT_START { \
+ if (pthread_cond_wait((c), (m))) \
+ croak("panic: COND_WAIT"); \
+ } STMT_END
+#define COND_DESTROY(c) \
+ STMT_START { \
+ if (pthread_cond_destroy((c))) \
+ croak("panic: COND_DESTROY"); \
+ } STMT_END
+#endif /* COND_INIT */
/* DETACH(t) must only be called while holding t->mutex */
-#define DETACH(t) \
- if (pthread_detach((t)->Tself)) { \
- MUTEX_UNLOCK(&(t)->mutex); \
- croak("panic: DETACH"); \
- } else 1
+#ifndef DETACH
+#define DETACH(t) \
+ STMT_START { \
+ if (pthread_detach((t)->Tself)) { \
+ MUTEX_UNLOCK(&(t)->mutex); \
+ croak("panic: DETACH"); \
+ } \
+ } STMT_END
+#endif /* DETACH */
-/* XXX Add "old" (?) POSIX draft interface too */
-#ifdef OLD_PTHREADS_API
+#ifndef JOIN
+#define JOIN(t, avp) \
+ STMT_START { \
+ if (pthread_join((t)->Tself, (void**)(avp))) \
+ croak("panic: pthread_join"); \
+ } STMT_END
+#endif /* JOIN */
+
+#ifndef SET_THR
+#define SET_THR(t) \
+ STMT_START { \
+ if (pthread_setspecific(thr_key, (void *) (t))) \
+ croak("panic: pthread_setspecific"); \
+ } STMT_END
+#endif /* SET_THR */
+
+#ifndef THR
+# ifdef OLD_PTHREADS_API
struct thread *getTHR _((void));
-#define THR getTHR()
-#else
-#define THR ((struct thread *) pthread_getspecific(thr_key))
-#endif /* OLD_PTHREADS_API */
-#define dTHR struct thread *thr = THR
-#endif /* FAKE_THREADS */
+# define THR getTHR()
+# else
+# define THR ((struct thread *) pthread_getspecific(thr_key))
+# endif /* OLD_PTHREADS_API */
+#endif /* THR */
+
+#ifndef dTHR
+# define dTHR struct thread *thr = THR
+#endif /* dTHR */
#ifndef INIT_THREADS
# ifdef NEED_PTHREAD_INIT
# endif
#endif
+#ifndef THREAD_RET_TYPE
+# define THREAD_RET_TYPE void *
+# define THREAD_RET_CAST(p) ((void *)(p))
+#endif /* THREAD_RET */
+
struct thread {
/* The fields that used to be global */
/* Important ones in the first cache line (if alignment is done right) */
#define runlevel (thr->Trunlevel)
#define cvcache (thr->Tcvcache)
+#else
+/* USE_THREADS is not defined */
+#define MUTEX_LOCK(m)
+#define MUTEX_UNLOCK(m)
+#define MUTEX_INIT(m)
+#define MUTEX_DESTROY(m)
+#define COND_INIT(c)
+#define COND_SIGNAL(c)
+#define COND_BROADCAST(c)
+#define COND_WAIT(c, m)
+#define COND_DESTROY(c)
+
+#define THR
+/* Rats: if dTHR is just blank then the subsequent ";" throws an error */
+#define dTHR extern int errno
#endif /* USE_THREADS */
.\include\sys\socket.h \
.\win32.h
-EXTENSIONS=DynaLoader Socket IO Fcntl Opcode SDBM_File
+EXTENSIONS=DynaLoader Socket IO Fcntl Opcode SDBM_File attrs
DYNALOADER=$(EXTDIR)\DynaLoader\DynaLoader
SOCKET=$(EXTDIR)\Socket\Socket
OPCODE=$(EXTDIR)\Opcode\Opcode
SDBM_FILE=$(EXTDIR)\SDBM_File\SDBM_File
IO=$(EXTDIR)\IO\IO
+ATTRS=$(EXTDIR)\attrs\attrs
SOCKET_DLL=..\lib\auto\Socket\Socket.dll
FCNTL_DLL=..\lib\auto\Fcntl\Fcntl.dll
OPCODE_DLL=..\lib\auto\Opcode\Opcode.dll
SDBM_FILE_DLL=..\lib\auto\SDBM_File\SDBM_File.dll
IO_DLL=..\lib\auto\IO\IO.dll
+ATTRS_DLL=..\lib\auto\attrs\attrs.dll
STATICLINKMODULES=DynaLoader
DYNALOADMODULES= \
$(FCNTL_DLL) \
$(OPCODE_DLL) \
$(SDBM_FILE_DLL)\
- $(IO_DLL)
+ $(IO_DLL) \
+ $(ATTRS_DLL)
POD2HTML=$(PODDIR)\pod2html
POD2MAN=$(PODDIR)\pod2man
$(EXTDIR)\DynaLoader\dl_win32.xs: dl_win32.xs
copy dl_win32.xs $(EXTDIR)\DynaLoader\dl_win32.xs
+$(ATTRS_DLL): $(PERLEXE) $(ATTRS).xs
+ cd $(EXTDIR)\$(*B)
+ ..\..\miniperl -I..\..\lib Makefile.PL INSTALLDIRS=perl
+ $(MAKE)
+ cd ..\..\win32
+
+
$(IO_DLL): $(PERLEXE) $(CONFIGPM) $(IO).xs
cd $(EXTDIR)\$(*B)
..\..\miniperl -I..\..\lib Makefile.PL INSTALLDIRS=perl
$(MAKE)
cd ..\..\win32
-$(SOCKET_DLL): $(SOCKET).xs $(PERLEXE)
+$(SOCKET_DLL): $(PERLEXE) $(SOCKET).xs
cd $(EXTDIR)\$(*B)
..\..\miniperl -I..\..\lib Makefile.PL INSTALLDIRS=perl
$(MAKE)
$(PERLIMPLIB) ..\miniperl.lib $(MINIMOD)
-del /f *.def *.map
-del /f $(SOCKET_DLL) $(IO_DLL) $(SDBM_FILE_DLL) $(FCNTL_DLL) \
- $(OPCODE_DLL)
+ $(OPCODE_DLL) $(ATTRS_DLL)
-del /f $(SOCKET).c $(IO).c $(SDBM_FILE).c $(FCNTL).c $(OPCODE).c \
- $(DYNALOADER).c
+ $(DYNALOADER).c $(ATTRS).c
-del /f $(PODDIR)\*.html
-del /f $(PODDIR)\*.bat
-del /f ..\config.sh ..\splittree.pl perlmain.c dlutils.c \
.\win32.h
-EXTENSIONS=DynaLoader Socket IO Fcntl Opcode SDBM_File
+EXTENSIONS=DynaLoader Socket IO Fcntl Opcode SDBM_File attrs
DYNALOADER=$(EXTDIR)\DynaLoader\DynaLoader
SOCKET=$(EXTDIR)\Socket\Socket
OPCODE=$(EXTDIR)\Opcode\Opcode
SDBM_FILE=$(EXTDIR)\SDBM_File\SDBM_File
IO=$(EXTDIR)\IO\IO
+ATTRS=$(EXTDIR)\attrs\attrs
SOCKET_DLL=..\lib\auto\Socket\Socket.dll
FCNTL_DLL=..\lib\auto\Fcntl\Fcntl.dll
OPCODE_DLL=..\lib\auto\Opcode\Opcode.dll
SDBM_FILE_DLL=..\lib\auto\SDBM_File\SDBM_File.dll
IO_DLL=..\lib\auto\IO\IO.dll
+ATTRS_DLL=..\lib\auto\attrs\attrs.dll
STATICLINKMODULES=DynaLoader
DYNALOADMODULES= \
$(FCNTL_DLL) \
$(OPCODE_DLL) \
$(SDBM_FILE_DLL)\
- $(IO_DLL)
+ $(IO_DLL) \
+ $(ATTRS_DLL)
POD2HTML=$(PODDIR)\pod2html
POD2MAN=$(PODDIR)\pod2man
$(EXTDIR)\DynaLoader\dl_win32.xs: dl_win32.xs
copy dl_win32.xs $(EXTDIR)\DynaLoader\dl_win32.xs
+$(ATTRS_DLL): $(PERLEXE) $(ATTRS).xs
+ cd $(EXTDIR)\$(*B) && \
+ ..\..\miniperl -I..\..\lib Makefile.PL INSTALLDIRS=perl
+ cd $(EXTDIR)\$(*B) && $(MAKE)
+
$(IO_DLL): $(PERLEXE) $(CONFIGPM) $(IO).xs
cd $(EXTDIR)\$(*B) && \
..\..\miniperl -I..\..\lib Makefile.PL INSTALLDIRS=perl
..\..\miniperl -I..\..\lib Makefile.PL INSTALLDIRS=perl
cd $(EXTDIR)\$(*B) && $(MAKE)
-$(SOCKET_DLL): $(SOCKET).xs $(PERLEXE)
+$(SOCKET_DLL): $(PERLEXE) $(SOCKET).xs
cd $(EXTDIR)\$(*B) && \
..\..\miniperl -I..\..\lib Makefile.PL INSTALLDIRS=perl
cd $(EXTDIR)\$(*B) && $(MAKE)
$(PERLIMPLIB) ..\miniperl.lib $(MINIMOD)
-del /f *.def *.map
-del /f $(SOCKET_DLL) $(IO_DLL) $(SDBM_FILE_DLL) $(FCNTL_DLL) \
- $(OPCODE_DLL)
+ $(OPCODE_DLL) $(ATTRS_DLL)
-del /f $(SOCKET).c $(IO).c $(SDBM_FILE).c $(FCNTL).c $(OPCODE).c \
- $(DYNALOADER).c
+ $(DYNALOADER).c $(ATTRS).c
-del /f $(PODDIR)\*.html
-del /f $(PODDIR)\*.bat
-del /f ..\config.sh ..\splittree.pl perlmain.c dlutils.c config.h.new
--- /dev/null
+#include "EXTERN.h"
+#include "perl.h"
+#include "win32/win32thread.h"
+
+void
+init_thread_intern(struct thread *thr)
+{
+ DuplicateHandle(GetCurrentProcess(),
+ GetCurrentThread(),
+ GetCurrentProcess(),
+ &self,
+ 0,
+ FALSE,
+ DUPLICATE_SAME_ACCESS);
+ if ((thr_key = TlsAlloc()) == TLS_OUT_OF_INDEXES)
+ croak("panic: TlsAlloc");
+ if (TlsSetValue(thr_key, (LPVOID) thr) != TRUE)
+ croak("panic: TlsSetValue");
+}
+
+int
+thread_create(struct thread *thr, THREAD_RET_TYPE (*fn)(void *))
+{
+ DWORD junk;
+
+ MUTEX_LOCK(&thr->mutex);
+ self = CreateThread(NULL, 0, fn, (void*)thr, 0, &junk);
+ MUTEX_UNLOCK(&thr->mutex);
+ return self ? 0 : -1;
+}
--- /dev/null
+/*typedef CRITICAL_SECTION perl_mutex;*/
+typedef HANDLE perl_mutex;
+typedef HANDLE perl_cond;
+typedef DWORD perl_key;
+typedef HANDLE perl_thread;
+
+/* XXX Critical Sections used instead of mutexes: lightweight,
+ * but can't be communicated to child processes, and can't get
+ * HANDLE to it for use elsewhere
+ */
+/*
+#define MUTEX_INIT(m) InitializeCriticalSection(m)
+#define MUTEX_LOCK(m) EnterCriticalSection(m)
+#define MUTEX_UNLOCK(m) LeaveCriticalSection(m)
+#define MUTEX_DESTROY(m) DeleteCriticalSection(m)
+*/
+
+#define MUTEX_INIT(m) \
+ STMT_START { \
+ if ((*(m) = CreateMutex(NULL,FALSE,NULL)) == NULL) \
+ croak("panic: MUTEX_INIT"); \
+ } STMT_END
+#define MUTEX_LOCK(m) \
+ STMT_START { \
+ if (WaitForSingleObject(*(m),INFINITE) == WAIT_FAILED) \
+ croak("panic: MUTEX_LOCK"); \
+ } STMT_END
+#define MUTEX_UNLOCK(m) \
+ STMT_START { \
+ if (ReleaseMutex(*(m)) == 0) \
+ croak("panic: MUTEX_UNLOCK"); \
+ } STMT_END
+#define MUTEX_DESTROY(m) \
+ STMT_START { \
+ if (CloseHandle(*(m)) == 0) \
+ croak("panic: MUTEX_DESTROY"); \
+ } STMT_END
+
+#define COND_INIT(c) \
+ STMT_START { \
+ if ((*(c) = CreateEvent(NULL,TRUE,FALSE,NULL)) == NULL) \
+ croak("panic: COND_INIT"); \
+ } STMT_END
+#define COND_SIGNAL(c) \
+ STMT_START { \
+ if (PulseEvent(*(c)) == 0) \
+ croak("panic: COND_SIGNAL (%ld)",GetLastError()); \
+ } STMT_END
+#define COND_BROADCAST(c) \
+ STMT_START { \
+ if (PulseEvent(*(c)) == 0) \
+ croak("panic: COND_BROADCAST"); \
+ } STMT_END
+/* #define COND_WAIT(c, m) \
+ STMT_START { \
+ if (WaitForSingleObject(*(c),INFINITE) == WAIT_FAILED) \
+ croak("panic: COND_WAIT"); \
+ } STMT_END
+*/
+#define COND_WAIT(c, m) \
+ STMT_START { \
+ if (SignalObjectAndWait(*(m),*(c),INFINITE,FALSE) == WAIT_FAILED)\
+ croak("panic: COND_WAIT"); \
+ else \
+ MUTEX_LOCK(m); \
+ } STMT_END
+#define COND_DESTROY(c) \
+ STMT_START { \
+ if (CloseHandle(*(c)) == 0) \
+ croak("panic: COND_DESTROY"); \
+ } STMT_END
+
+#define DETACH(t) \
+ STMT_START { \
+ if (CloseHandle((t)->Tself) == 0) { \
+ MUTEX_UNLOCK(&(t)->mutex); \
+ croak("panic: DETACH"); \
+ } \
+ } STMT_END
+
+#define THR ((struct thread *) TlsGetValue(thr_key))
+
+#define HAVE_THREAD_INTERN
+
+#define JOIN(t, avp) \
+ STMT_START { \
+ if ((WaitForSingleObject((t)->Tself,INFINITE) == WAIT_FAILED) \
+ || (GetExitCodeThread((t)->Tself,(LPDWORD)(avp)) == 0)) \
+ croak("panic: JOIN"); \
+ } STMT_END
+
+#define SET_THR(t) \
+ STMT_START { \
+ if (TlsSetValue(thr_key, (void *) (t)) == 0) \
+ croak("panic: TlsSetValue"); \
+ } STMT_END
+
+#define THREAD_CREATE(t, f) thread_create(t, f)
+#define THREAD_POST_CREATE(t) NOOP
+#define THREAD_RET_TYPE DWORD WINAPI
+#define THREAD_RET_CAST(p) ((DWORD)(p))
+#define YIELD Sleep(0)
projects / p5sagit/p5-mst-13.2.git / commitdiff