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
|
#ifndef _WIN32THREAD_H
#define _WIN32THREAD_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) \
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
#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 = CreateSemaphore(NULL,0,LONG_MAX,NULL); \
if ((c)->sem == NULL) \
croak("panic: COND_INIT (%ld)",GetLastError()); \
} STMT_END
#define COND_SIGNAL(c) \
STMT_START { \
if ((c)->waiters > 0 && \
ReleaseSemaphore((c)->sem,1,NULL) == 0) \
croak("panic: COND_SIGNAL (%ld)",GetLastError()); \
} STMT_END
#define COND_BROADCAST(c) \
STMT_START { \
if ((c)->waiters > 0 && \
ReleaseSemaphore((c)->sem,(c)->waiters,NULL) == 0) \
croak("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)\
croak("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) \
croak("panic: COND_DESTROY (%ld)",GetLastError()); \
} STMT_END
#define DETACH(t) \
STMT_START { \
if (CloseHandle((t)->self) == 0) { \
MUTEX_UNLOCK(&(t)->mutex); \
croak("panic: DETACH"); \
} \
} STMT_END
#define THR ((struct thread *) TlsGetValue(thr_key))
#define THREAD_CREATE(t, f) Perl_thread_create(t, f)
#define THREAD_POST_CREATE(t) NOOP
#define THREAD_RET_TYPE DWORD WINAPI
#define THREAD_RET_CAST(p) ((DWORD)(p))
typedef THREAD_RET_TYPE thread_func_t(void *);
START_EXTERN_C
void Perl_alloc_thread_key _((void));
int Perl_thread_create _((struct thread *thr, thread_func_t *fn));
void Perl_set_thread_self _((struct thread *thr));
END_EXTERN_C
#define INIT_THREADS NOOP
#define ALLOC_THREAD_KEY Perl_alloc_thread_key()
#define SET_THREAD_SELF(thr) Perl_set_thread_self(thr)
#define JOIN(t, avp) \
STMT_START { \
if ((WaitForSingleObject((t)->self,INFINITE) == WAIT_FAILED) \
|| (GetExitCodeThread((t)->self,(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 YIELD Sleep(0)
#endif /* _WIN32THREAD_H */
|
