source: trunk/third/perl/win32/win32thread.h @ 14545

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