1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186
|
#ifndef _WIN32THREAD_H
#define _WIN32THREAD_H
#include "win32.h"
typedef struct win32_cond { LONG waiters; HANDLE sem; } perl_cond;
typedef DWORD perl_key;
typedef HANDLE perl_os_thread;
#ifndef DONT_USE_CRITICAL_SECTION
/* 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.
*/
typedef CRITICAL_SECTION perl_mutex;
#define MUTEX_INIT(m) InitializeCriticalSection(m)
#define MUTEX_LOCK(m) EnterCriticalSection(m)
#define MUTEX_UNLOCK(m) LeaveCriticalSection(m)
#define MUTEX_DESTROY(m) DeleteCriticalSection(m)
#else
typedef HANDLE perl_mutex;
# define MUTEX_INIT(m) \
STMT_START { \
if ((*(m) = CreateMutex(NULL,FALSE,NULL)) == NULL) \
Perl_croak_nocontext("panic: MUTEX_INIT"); \
} STMT_END
# define MUTEX_LOCK(m) \
STMT_START { \
if (WaitForSingleObject(*(m),INFINITE) == WAIT_FAILED) \
Perl_croak_nocontext("panic: MUTEX_LOCK"); \
} STMT_END
# define MUTEX_UNLOCK(m) \
STMT_START { \
if (ReleaseMutex(*(m)) == 0) \
Perl_croak_nocontext("panic: MUTEX_UNLOCK"); \
} STMT_END
# define MUTEX_DESTROY(m) \
STMT_START { \
if (CloseHandle(*(m)) == 0) \
Perl_croak_nocontext("panic: MUTEX_DESTROY"); \
} STMT_END
#endif
/* These macros assume that the mutex associated with the condition
* will always be held before COND_{SIGNAL,BROADCAST,WAIT,DESTROY},
* so there's no separate mutex protecting access to (c)->waiters
*/
#define COND_INIT(c) \
STMT_START { \
(c)->waiters = 0; \
(c)->sem = Win_CreateSemaphore(NULL,0,LONG_MAX,NULL); \
if ((c)->sem == NULL) \
Perl_croak_nocontext("panic: COND_INIT (%ld)",GetLastError()); \
} STMT_END
#define COND_SIGNAL(c) \
STMT_START { \
if ((c)->waiters > 0 && \
ReleaseSemaphore((c)->sem,1,NULL) == 0) \
Perl_croak_nocontext("panic: COND_SIGNAL (%ld)",GetLastError()); \
} STMT_END
#define COND_BROADCAST(c) \
STMT_START { \
if ((c)->waiters > 0 && \
ReleaseSemaphore((c)->sem,(c)->waiters,NULL) == 0) \
Perl_croak_nocontext("panic: COND_BROADCAST (%ld)",GetLastError());\
} STMT_END
#define COND_WAIT(c, m) \
STMT_START { \
(c)->waiters++; \
MUTEX_UNLOCK(m); \
/* Note that there's no race here, since a \
* COND_BROADCAST() on another thread will have seen the\
* right number of waiters (i.e. including this one) */ \
if (WaitForSingleObject((c)->sem,INFINITE)==WAIT_FAILED)\
Perl_croak_nocontext("panic: COND_WAIT (%ld)",GetLastError()); \
/* XXX there may be an inconsequential race here */ \
MUTEX_LOCK(m); \
(c)->waiters--; \
} STMT_END
#define COND_DESTROY(c) \
STMT_START { \
(c)->waiters = 0; \
if (CloseHandle((c)->sem) == 0) \
Perl_croak_nocontext("panic: COND_DESTROY (%ld)",GetLastError()); \
} STMT_END
#define DETACH(t) \
STMT_START { \
if (CloseHandle((t)->self) == 0) { \
MUTEX_UNLOCK(&(t)->mutex); \
Perl_croak_nocontext("panic: DETACH"); \
} \
} STMT_END
/* XXX Docs mention that the RTL versions of thread creation routines
* should be used, but that advice only seems applicable when the RTL
* is not in a DLL. RTL DLLs seem to do all of the init/deinit required
* upon DLL_THREAD_ATTACH/DETACH. So we seem to be completely safe using
* straight Win32 API calls, rather than the much braindamaged RTL calls.
*
* _beginthread() in the RTLs call CloseHandle() just after the thread
* function returns, which means: 1) we have a race on our hands
* 2) it is impossible to implement join() semantics.
*
* IOW, do *NOT* turn on USE_RTL_THREAD_API! It is here
* for experimental purposes only. GSAR 98-01-02
*/
#ifdef USE_RTL_THREAD_API
# include <process.h>
# if defined (_MSC_VER)
# define THREAD_RET_TYPE unsigned __stdcall
# else
/* CRTDLL.DLL doesn't allow a return value from thread function! */
# define THREAD_RET_TYPE void __cdecl
# endif
#else /* !USE_RTL_THREAD_API */
# define THREAD_RET_TYPE DWORD WINAPI
#endif /* !USE_RTL_THREAD_API */
typedef THREAD_RET_TYPE thread_func_t(void *);
START_EXTERN_C
#if defined(PERLDLL) && defined(USE_DECLSPEC_THREAD)
extern __declspec(thread) void *PL_current_context;
#define PERL_SET_CONTEXT(t) (PL_current_context = t)
#define PERL_GET_CONTEXT PL_current_context
#else
#define PERL_GET_CONTEXT Perl_get_context()
#define PERL_SET_CONTEXT(t) Perl_set_context(t)
#endif
END_EXTERN_C
#define INIT_THREADS NOOP
#define ALLOC_THREAD_KEY \
STMT_START { \
if ((PL_thr_key = TlsAlloc()) == TLS_OUT_OF_INDEXES) { \
PerlIO_printf(PerlIO_stderr(),"panic: TlsAlloc"); \
exit(1); \
} \
} STMT_END
#define FREE_THREAD_KEY \
STMT_START { \
TlsFree(PL_thr_key); \
} STMT_END
#define PTHREAD_ATFORK(prepare,parent,child) NOOP
#if defined(USE_RTL_THREAD_API) && !defined(_MSC_VER)
#define JOIN(t, avp) \
STMT_START { \
if ((WaitForSingleObject((t)->self,INFINITE) == WAIT_FAILED) \
|| (GetExitCodeThread((t)->self,(LPDWORD)(avp)) == 0) \
|| (CloseHandle((t)->self) == 0)) \
Perl_croak_nocontext("panic: JOIN"); \
*avp = (AV *)((t)->i.retv); \
} STMT_END
#else /* !USE_RTL_THREAD_API || _MSC_VER */
#define JOIN(t, avp) \
STMT_START { \
if ((WaitForSingleObject((t)->self,INFINITE) == WAIT_FAILED) \
|| (GetExitCodeThread((t)->self,(LPDWORD)(avp)) == 0) \
|| (CloseHandle((t)->self) == 0)) \
Perl_croak_nocontext("panic: JOIN"); \
} STMT_END
#endif /* !USE_RTL_THREAD_API || _MSC_VER */
#define YIELD Sleep(0)
#endif /* _WIN32THREAD_H */
|