This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Integrate mainline changes into win32 branch. Now would be a good time
[perl5.git] / thread.h
index 4fc37c9..2b8e636 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)
+#ifdef USE_THREADS
 
-#define THR
-/* Rats: if dTHR is just blank then the subsequent ";" throws an error */
-#define dTHR extern int errno
+#ifdef WIN32
+#  include <win32thread.h>
 #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
-
-/*
- * 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();                     \
+/* 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 YIELD pthread_yield()
+#  define DETACH(t)                            \
+    STMT_START {                               \
+       if (pthread_detach(&(t)->self)) {       \
+           MUTEX_UNLOCK(&(t)->mutex);          \
+           croak("panic: DETACH");             \
+       }                                       \
     } STMT_END
-#define COND_DESTROY(c)
 #else
+#  define pthread_mutexattr_default NULL
+#  define pthread_condattr_default NULL
+#  define pthread_attr_default NULL
+#endif /* OLD_PTHREADS_API */
+#endif
 
-#ifdef WIN32
-
-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)
-*/
+#ifndef YIELD
+#  define YIELD sched_yield()
+#endif
 
-#define MUTEX_INIT(m) \
+#ifndef MUTEX_INIT
+#define MUTEX_INIT(m)                                          \
     STMT_START {                                               \
-       if ((*(m) = CreateMutex(NULL,FALSE,NULL)) == NULL)      \
+       if (pthread_mutex_init((m), pthread_mutexattr_default)) \
            croak("panic: MUTEX_INIT");                         \
     } STMT_END
-#define MUTEX_LOCK(m) \
-    STMT_START {                                               \
-       if (WaitForSingleObject(*(m),INFINITE) == WAIT_FAILED)  \
-           croak("panic: MUTEX_LOCK");                         \
+#define MUTEX_LOCK(m)                          \
+    STMT_START {                               \
+       if (pthread_mutex_lock((m)))            \
+           croak("panic: MUTEX_LOCK");         \
     } STMT_END
-#define MUTEX_UNLOCK(m) \
-    STMT_START {                                               \
-       if (ReleaseMutex(*(m)) == 0)                            \
-           croak("panic: MUTEX_UNLOCK");                       \
+#define MUTEX_UNLOCK(m)                                \
+    STMT_START {                               \
+       if (pthread_mutex_unlock((m)))          \
+           croak("panic: MUTEX_UNLOCK");       \
     } STMT_END
-#define MUTEX_DESTROY(m) \
-    STMT_START {                                               \
-       if (CloseHandle(*(m)) == 0)                             \
-           croak("panic: MUTEX_DESTROY");                      \
+#define MUTEX_DESTROY(m)                       \
+    STMT_START {                               \
+       if (pthread_mutex_destroy((m)))         \
+           croak("panic: MUTEX_DESTROY");      \
     } STMT_END
+#endif /* MUTEX_INIT */
 
-#define COND_INIT(c) \
+#ifndef COND_INIT
+#define COND_INIT(c)                                           \
     STMT_START {                                               \
-       if ((*(c) = CreateEvent(NULL,TRUE,FALSE,NULL)) == NULL) \
+       if (pthread_cond_init((c), pthread_condattr_default))   \
            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");                     \
+#define COND_SIGNAL(c)                         \
+    STMT_START {                               \
+       if (pthread_cond_signal((c)))           \
+           croak("panic: COND_SIGNAL");        \
     } STMT_END
-/* #define COND_WAIT(c, m) \
-    STMT_START {                                               \
-       if (WaitForSingleObject(*(c),INFINITE) == WAIT_FAILED)  \
-           croak("panic: COND_WAIT");                          \
+#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 (SignalObjectAndWait(*(m),*(c),INFINITE,FALSE) == WAIT_FAILED)\
-           croak("panic: COND_WAIT");                          \
-       else                                                    \
-           MUTEX_LOCK(m);                                      \
+#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 (CloseHandle(*(c)) == 0)                             \
-           croak("panic: COND_DESTROY");                       \
+#define COND_DESTROY(c)                                \
+    STMT_START {                               \
+       if (pthread_cond_destroy((c)))          \
+           croak("panic: COND_DESTROY");       \
     } STMT_END
+#endif /* COND_INIT */
 
-#define DETACH(t) \
-    STMT_START {                                               \
-       if (CloseHandle((t)->Tself) == 0) {                     \
-           MUTEX_UNLOCK(&(t)->mutex);                          \
-           croak("panic: DETACH");                             \
-       }                                                       \
+/* DETACH(t) must only be called while holding t->mutex */
+#ifndef DETACH
+#define DETACH(t)                              \
+    STMT_START {                               \
+       if (pthread_detach((t)->self)) {        \
+           MUTEX_UNLOCK(&(t)->mutex);          \
+           croak("panic: DETACH");             \
+       }                                       \
     } STMT_END
+#endif /* DETACH */
 
-#define THR ((struct thread *) TlsGetValue(thr_key))
-#define pthread_getspecific(k)         TlsGetValue(k)
-#define pthread_setspecific(k,v)       (TlsSetValue(k,v) == 0)
-
-#else /* !WIN32 */
-
-/* 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))
-#else
-#define pthread_mutexattr_default NULL
-#define pthread_condattr_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 JOIN
+#define JOIN(t, avp)                                   \
+    STMT_START {                                       \
+       if (pthread_join((t)->self, (void**)(avp)))     \
+           croak("panic: pthread_join");               \
+    } STMT_END
+#endif /* JOIN */
 
-/* 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 SET_THR
+#define SET_THR(t)                                     \
+    STMT_START {                                       \
+       if (pthread_setspecific(thr_key, (void *) (t))) \
+           croak("panic: pthread_setspecific");        \
+    } STMT_END
+#endif /* SET_THR */
 
-/* XXX Add "old" (?) POSIX draft interface too */
-#ifdef OLD_PTHREADS_API
+#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 */
-#endif /* WIN32 */
-#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
@@ -184,6 +128,12 @@ 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) */
@@ -223,10 +173,25 @@ struct thread {
 
     /* Now the fields that used to be "per interpreter" (even when global) */
 
-    /* XXX What about magic variables such as $/, $? and so on? */
+    /* Fields used by magic variables such as $@, $/ and so on */
+    bool       Ttainted;
+    PMOP *     Tcurpm;
+    SV *       Tnrs;
+    SV *       Trs;
+    GV *       Tlast_in_gv;
+    char *     Tofs;
+    STRLEN     Tofslen;
+    GV *       Tdefoutgv;
+    char *     Tchopset;
+    SV *       Tformtarget;
+    SV *       Tbodytarget;
+    SV *       Ttoptarget;
+
+    /* Stashes */
     HV *       Tdefstash;
     HV *       Tcurstash;
 
+    /* Stacks */
     SV **      Ttmps_stack;
     I32                Ttmps_ix;
     I32                Ttmps_floor;
@@ -239,28 +204,32 @@ struct thread {
     U8         Tlocalizing;
     COP *      Tcurcop;
 
-    CONTEXT *  Tcxstack;
+    PERL_CONTEXT *     Tcxstack;
     I32                Tcxstack_ix;
     I32                Tcxstack_max;
 
     AV *       Tcurstack;
     AV *       Tmainstack;
     JMPENV *   Ttop_env;
-    I32                Trunlevel;
 
     /* XXX Sort stuff, firstgv, secongv and so on? */
 
-    perl_thread        Tself;
-    SV *       Toursv;
-    HV *       Tcvcache;
+    SV *       oursv;
+    HV *       cvcache;
+    perl_thread        self;                   /* Underlying thread object */
     U32                flags;
+    AV *       magicals;               /* Per-thread magicals */
+    AV *       specific;               /* Thread-specific user data */
+    SV *       errsv;                  /* Backing SV for $@ */
+    HV *       errhv;                  /* HV for what was %@ in pp_ctl.c */
     perl_mutex mutex;                  /* For the fields others can change */
     U32                tid;
     struct thread *next, *prev;                /* Circular linked list of threads */
-
-#ifdef ADD_THREAD_INTERN
+    JMPENV     Tstart_env;             /* Top of top_env longjmp() chain */ 
+#ifdef HAVE_THREAD_INTERN
     struct thread_intern i;            /* Platform-dependent internals */
 #endif
+    char       trailing_nul;           /* For the sake of thrsv and oursv */
 };
 
 typedef struct thread *Thread;
@@ -273,10 +242,10 @@ typedef struct thread *Thread;
 #define THRf_ZOMBIE    3
 #define THRf_DEAD      4
 
-#define THRf_DIE_FATAL 8
+#define THRf_DID_DIE   8
 
 /* ThrSTATE(t) and ThrSETSTATE(t) must only be called while holding t->mutex */
-#define ThrSTATE(t) ((t)->flags)
+#define ThrSTATE(t) ((t)->flags & THRf_STATE_MASK)
 #define ThrSETSTATE(t, s) STMT_START {         \
        (t)->flags &= ~THRf_STATE_MASK;         \
        (t)->flags |= (s);                      \
@@ -328,16 +297,26 @@ typedef struct condpair {
 #undef Xpv
 #undef statbuf
 #undef timesbuf
+#undef tainted
+#undef curpm
+#undef nrs
+#undef rs
+#undef last_in_gv
+#undef ofs
+#undef ofslen
+#undef defoutgv
+#undef chopset
+#undef formtarget
+#undef bodytarget
+#undef  start_env
+#undef toptarget
 #undef top_env
-#undef runlevel
 #undef in_eval
 #undef restartop
 #undef delaymagic
 #undef dirty
 #undef localizing
 
-#define self           (thr->Tself)
-#define oursv          (thr->Toursv)
 #define stack_base     (thr->Tstack_base)
 #define stack_sp       (thr->Tstack_sp)
 #define stack_max      (thr->Tstack_max)
@@ -375,6 +354,19 @@ typedef struct condpair {
 #define Xpv            (thr->TXpv)
 #define statbuf                (thr->Tstatbuf)
 #define timesbuf       (thr->Ttimesbuf)
+#define        tainted         (thr->Ttainted)
+#define        tainted         (thr->Ttainted)
+#define        curpm           (thr->Tcurpm)
+#define        nrs             (thr->Tnrs)
+#define        rs              (thr->Trs)
+#define        last_in_gv      (thr->Tlast_in_gv)
+#define        ofs             (thr->Tofs)
+#define        ofslen          (thr->Tofslen)
+#define        defoutgv        (thr->Tdefoutgv)
+#define        chopset         (thr->Tchopset)
+#define        formtarget      (thr->Tformtarget)
+#define        bodytarget      (thr->Tbodytarget)
+#define        toptarget       (thr->Ttoptarget)
 #define defstash       (thr->Tdefstash)
 #define curstash       (thr->Tcurstash)
 
@@ -390,7 +382,21 @@ typedef struct condpair {
 #define localizing     (thr->Tlocalizing)
 
 #define        top_env         (thr->Ttop_env)
-#define        runlevel        (thr->Trunlevel)
+#define start_env       (thr->Tstart_env)
+
+#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        cvcache         (thr->Tcvcache)
+#define THR
+/* Rats: if dTHR is just blank then the subsequent ";" throws an error */
+#define dTHR extern int errno
 #endif /* USE_THREADS */