Improve internal threading API. Introduce win32/win32thread.[ch]
authorMalcolm Beattie <mbeattie@sable.ox.ac.uk>
Fri, 24 Oct 1997 13:50:59 +0000 (13:50 +0000)
committerMalcolm Beattie <mbeattie@sable.ox.ac.uk>
Fri, 24 Oct 1997 13:50:59 +0000 (13:50 +0000)
to use new API and patch win32 makefile stuff a little.

p4raw-id: //depot/perl@172

12 files changed:
Todo.5.005
ext/Thread/Thread.xs
fakethr.h
global.sym
gv.c
perl.c
perl.h
thread.h
win32/Makefile
win32/makefile.mk
win32/win32thread.c [new file with mode: 0644]
win32/win32thread.h [new file with mode: 0644]

index 1159da5..af30f0e 100644 (file)
@@ -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
index 3dc2516..24a11df 100644 (file)
@@ -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);
index dac2cc9..eaab4b8 100644 (file)
--- a/fakethr.h
+++ b/fakethr.h
@@ -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
index 33a3425..549a754 100644 (file)
@@ -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
diff --git a/gv.c b/gv.c
index 0928d68..16f16ae 100644 (file)
--- a/gv.c
+++ b/gv.c
@@ -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 */
diff --git a/perl.c b/perl.c
index 5a2dd70..f816892 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -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 */
diff --git a/perl.h b/perl.h
index c8eee3d..c8a33a0 100644 (file)
--- a/perl.h
+++ b/perl.h
@@ -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 */
 
 /*
index b375c98..b92e832 100644 (file)
--- a/thread.h
+++ b/thread.h
-#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 */
index 7a98f84..b779ff3 100644 (file)
@@ -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 \
index dbac98f..ffd66d5 100644 (file)
@@ -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 (file)
index 0000000..e74d7e8
--- /dev/null
@@ -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 (file)
index 0000000..46e0a58
--- /dev/null
@@ -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)