diff options
| -rw-r--r-- | Todo.5.005 | 8 | ||||
| -rw-r--r-- | ext/Thread/Thread.xs | 56 | ||||
| -rw-r--r-- | fakethr.h | 30 | ||||
| -rw-r--r-- | global.sym | 3 | ||||
| -rw-r--r-- | gv.c | 2 | ||||
| -rw-r--r-- | perl.c | 11 | ||||
| -rw-r--r-- | perl.h | 15 | ||||
| -rw-r--r-- | thread.h | 207 | ||||
| -rw-r--r-- | win32/Makefile | 20 | ||||
| -rw-r--r-- | win32/makefile.mk | 18 | ||||
| -rw-r--r-- | win32/win32thread.c | 30 | ||||
| -rw-r--r-- | win32/win32thread.h | 102 |
12 files changed, 371 insertions, 131 deletions
diff --git a/Todo.5.005 b/Todo.5.005 index 1159da58d1..af30f0e5e9 100644 --- a/Todo.5.005 +++ b/Todo.5.005 @@ -1,23 +1,21 @@ 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 diff --git a/ext/Thread/Thread.xs b/ext/Thread/Thread.xs index 3dc25162a7..24a11df67c 100644 --- a/ext/Thread/Thread.xs +++ b/ext/Thread/Thread.xs @@ -23,7 +23,7 @@ Thread t; MUTEX_UNLOCK(&threads_mutex); } -static void * +static THREAD_RET_TYPE threadstart(arg) void *arg; { @@ -81,8 +81,8 @@ 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); @@ -92,8 +92,7 @@ void *arg; * 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", @@ -182,9 +181,9 @@ void *arg; 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 } @@ -199,7 +198,10 @@ char *class; Thread savethread; int i; SV *sv; + int err; +#ifndef THREAD_CREATE sigset_t fullmask, oldmask; +#endif savethread = thr; sv = newSVpv("", 0); @@ -245,21 +247,32 @@ char *class; 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 @@ -312,8 +325,7 @@ join(t) 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++) @@ -389,13 +401,7 @@ DESTROY(t) 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) @@ -536,7 +542,7 @@ SV * await_signal() PREINIT: char c; - ssize_t ret; + SSize_t ret; CODE: do { ret = read(sig_pipe[1], &c, 1); @@ -1,6 +1,10 @@ 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; @@ -24,3 +28,29 @@ struct thread_intern { (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 diff --git a/global.sym b/global.sym index 33a3425ef7..549a754b59 100644 --- a/global.sym +++ b/global.sym @@ -69,6 +69,7 @@ gid gt_amg hexdigit hints +init_thread_intern in_my in_my_stash inc_amg @@ -139,6 +140,7 @@ nomem nomemok nomethod_amg not_amg +nthreads numeric_local numeric_name numeric_standard @@ -236,6 +238,7 @@ sv_no sv_undef sv_yes thisexpr +thr_key timesbuf tokenbuf uid @@ -638,7 +638,7 @@ I32 sv_type; 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 */ @@ -124,7 +124,7 @@ register PerlInterpreter *sv_interp; 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 */ @@ -158,9 +158,8 @@ register PerlInterpreter *sv_interp; 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); @@ -279,8 +278,7 @@ register PerlInterpreter *sv_interp; * 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)); @@ -2178,6 +2176,7 @@ char *scriptname; */ #ifdef DOSUID + dTHR; char *s, *s2; if (Fstat(PerlIO_fileno(rsfp),&statbuf) < 0) /* normal stat is insecure */ @@ -63,15 +63,20 @@ register struct op *op asm(stringify(OP_IN_REGISTER)); #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 */ /* @@ -1,94 +1,123 @@ -#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 @@ -98,6 +127,11 @@ struct thread *getTHR _((void)); # 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) */ @@ -308,4 +342,19 @@ typedef struct condpair { #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 */ diff --git a/win32/Makefile b/win32/Makefile index 7a98f84c2c..b779ff3935 100644 --- a/win32/Makefile +++ b/win32/Makefile @@ -241,7 +241,7 @@ CORE_H = ..\av.h \ .\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 @@ -249,12 +249,14 @@ FCNTL=$(EXTDIR)\Fcntl\Fcntl 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= \ @@ -262,7 +264,8 @@ DYNALOADMODULES= \ $(FCNTL_DLL) \ $(OPCODE_DLL) \ $(SDBM_FILE_DLL)\ - $(IO_DLL) + $(IO_DLL) \ + $(ATTRS_DLL) POD2HTML=$(PODDIR)\pod2html POD2MAN=$(PODDIR)\pod2man @@ -383,6 +386,13 @@ $(DYNALOADER).c: $(MINIPERL) $(EXTDIR)\DynaLoader\dl_win32.xs $(CONFIGPM) $(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 @@ -407,7 +417,7 @@ $(OPCODE_DLL): $(PERLEXE) $(OPCODE).xs $(MAKE) cd ..\..\win32 -$(SOCKET_DLL): $(SOCKET).xs $(PERLEXE) +$(SOCKET_DLL): $(PERLEXE) $(SOCKET).xs cd $(EXTDIR)\$(*B) ..\..\miniperl -I..\..\lib Makefile.PL INSTALLDIRS=perl $(MAKE) @@ -439,9 +449,9 @@ distclean: clean $(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 \ diff --git a/win32/makefile.mk b/win32/makefile.mk index dbac98f7ff..ffd66d566d 100644 --- a/win32/makefile.mk +++ b/win32/makefile.mk @@ -308,7 +308,7 @@ CORE_H = ..\av.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 @@ -316,12 +316,14 @@ FCNTL=$(EXTDIR)\Fcntl\Fcntl 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= \ @@ -329,7 +331,8 @@ DYNALOADMODULES= \ $(FCNTL_DLL) \ $(OPCODE_DLL) \ $(SDBM_FILE_DLL)\ - $(IO_DLL) + $(IO_DLL) \ + $(ATTRS_DLL) POD2HTML=$(PODDIR)\pod2html POD2MAN=$(PODDIR)\pod2man @@ -483,6 +486,11 @@ $(DYNALOADER).c: $(MINIPERL) $(EXTDIR)\DynaLoader\dl_win32.xs $(CONFIGPM) $(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 @@ -503,7 +511,7 @@ $(OPCODE_DLL): $(PERLEXE) $(OPCODE).xs ..\..\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) @@ -530,9 +538,9 @@ distclean: clean $(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 diff --git a/win32/win32thread.c b/win32/win32thread.c new file mode 100644 index 0000000000..e74d7e8933 --- /dev/null +++ b/win32/win32thread.c @@ -0,0 +1,30 @@ +#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; +} diff --git a/win32/win32thread.h b/win32/win32thread.h new file mode 100644 index 0000000000..46e0a58fb6 --- /dev/null +++ b/win32/win32thread.h @@ -0,0 +1,102 @@ +/*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) |