This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
B::Deparse for(1..100000)
[perl5.git] / thread.h
1 #ifdef USE_THREADS
2
3 #ifdef WIN32
4 #  include <win32thread.h>
5 #else
6
7 #ifndef DJGPP
8 /* POSIXish threads */
9 #ifdef OLD_PTHREADS_API
10 #  define pthread_mutexattr_init(a) pthread_mutexattr_create(a)
11 #  define pthread_mutexattr_settype(a,t) pthread_mutexattr_setkind_np(a,t)
12 #  define pthread_key_create(k,d) pthread_keycreate(k,(pthread_destructor_t)(d))
13 #  define YIELD pthread_yield()
14 #  define DETACH(t)                             \
15     STMT_START {                                \
16         if (pthread_detach(&(t)->self)) {       \
17             MUTEX_UNLOCK(&(t)->mutex);          \
18             croak("panic: DETACH");             \
19         }                                       \
20     } STMT_END
21 #else
22 #  define pthread_mutexattr_default NULL
23 #  define pthread_condattr_default NULL
24 #endif /* OLD_PTHREADS_API */
25 #endif
26 #endif
27
28 #ifdef PTHREADS_CREATED_JOINABLE
29 #  define ATTR_JOINABLE PTHREAD_CREATE_JOINABLE
30 #else
31 #  ifdef PTHREAD_CREATE_UNDETACHED
32 #    define ATTR_JOINABLE PTHREAD_CREATE_UNDETACHED
33 #  else
34 #    define ATTR_JOINABLE PTHREAD_CREATE_JOINABLE
35 #  endif
36 #endif
37
38 #ifndef YIELD
39 #  ifdef HAS_SCHED_YIELD
40 #    define YIELD sched_yield()
41 #  else
42 #    ifdef HAS_PTHREAD_YIELD
43 #      define YIELD pthread_yield()
44 #    endif
45 #  endif
46 #endif
47
48 #ifndef MUTEX_INIT
49 #define MUTEX_INIT(m)                                           \
50     STMT_START {                                                \
51         if (pthread_mutex_init((m), pthread_mutexattr_default)) \
52             croak("panic: MUTEX_INIT");                         \
53     } STMT_END
54 #define MUTEX_LOCK(m)                           \
55     STMT_START {                                \
56         if (pthread_mutex_lock((m)))            \
57             croak("panic: MUTEX_LOCK");         \
58     } STMT_END
59 #define MUTEX_UNLOCK(m)                         \
60     STMT_START {                                \
61         if (pthread_mutex_unlock((m)))          \
62             croak("panic: MUTEX_UNLOCK");       \
63     } STMT_END
64 #define MUTEX_DESTROY(m)                        \
65     STMT_START {                                \
66         if (pthread_mutex_destroy((m)))         \
67             croak("panic: MUTEX_DESTROY");      \
68     } STMT_END
69 #endif /* MUTEX_INIT */
70
71 #ifndef COND_INIT
72 #define COND_INIT(c)                                            \
73     STMT_START {                                                \
74         if (pthread_cond_init((c), pthread_condattr_default))   \
75             croak("panic: COND_INIT");                          \
76     } STMT_END
77 #define COND_SIGNAL(c)                          \
78     STMT_START {                                \
79         if (pthread_cond_signal((c)))           \
80             croak("panic: COND_SIGNAL");        \
81     } STMT_END
82 #define COND_BROADCAST(c)                       \
83     STMT_START {                                \
84         if (pthread_cond_broadcast((c)))        \
85             croak("panic: COND_BROADCAST");     \
86     } STMT_END
87 #define COND_WAIT(c, m)                         \
88     STMT_START {                                \
89         if (pthread_cond_wait((c), (m)))        \
90             croak("panic: COND_WAIT");          \
91     } STMT_END
92 #define COND_DESTROY(c)                         \
93     STMT_START {                                \
94         if (pthread_cond_destroy((c)))          \
95             croak("panic: COND_DESTROY");       \
96     } STMT_END
97 #endif /* COND_INIT */
98
99 /* DETACH(t) must only be called while holding t->mutex */
100 #ifndef DETACH
101 #define DETACH(t)                               \
102     STMT_START {                                \
103         if (pthread_detach((t)->self)) {        \
104             MUTEX_UNLOCK(&(t)->mutex);          \
105             croak("panic: DETACH");             \
106         }                                       \
107     } STMT_END
108 #endif /* DETACH */
109
110 #ifndef JOIN
111 #define JOIN(t, avp)                                    \
112     STMT_START {                                        \
113         if (pthread_join((t)->self, (void**)(avp)))     \
114             croak("panic: pthread_join");               \
115     } STMT_END
116 #endif /* JOIN */
117
118 #ifndef SET_THR
119 #define SET_THR(t)                                      \
120     STMT_START {                                        \
121         if (pthread_setspecific(thr_key, (void *) (t))) \
122             croak("panic: pthread_setspecific");        \
123     } STMT_END
124 #endif /* SET_THR */
125
126 #ifndef THR
127 #  ifdef OLD_PTHREADS_API
128 struct perl_thread *getTHR _((void));
129 #    define THR getTHR()
130 #  else
131 #    define THR ((struct perl_thread *) pthread_getspecific(thr_key))
132 #  endif /* OLD_PTHREADS_API */
133 #endif /* THR */
134
135 /*
136  * dTHR is performance-critical. Here, we only do the pthread_get_specific
137  * if there may be more than one thread in existence, otherwise we get thr
138  * from thrsv which is cached in the per-interpreter structure.
139  * Systems with very fast pthread_get_specific (which should be all systems
140  * but unfortunately isn't) may wish to simplify to "...*thr = THR".
141  */
142 #ifndef dTHR
143 #  define dTHR \
144     struct perl_thread *thr = threadnum? THR : (struct perl_thread*)SvPVX(thrsv)
145 #endif /* dTHR */
146
147 #ifndef INIT_THREADS
148 #  ifdef NEED_PTHREAD_INIT
149 #    define INIT_THREADS pthread_init()
150 #  else
151 #    define INIT_THREADS NOOP
152 #  endif
153 #endif
154
155 /* Accessor for per-thread SVs */
156 #define THREADSV(i) (thr->threadsvp[i])
157
158 /*
159  * LOCK_SV_MUTEX and UNLOCK_SV_MUTEX are performance-critical. Here, we
160  * try only locking them if there may be more than one thread in existence.
161  * Systems with very fast mutexes (and/or slow conditionals) may wish to
162  * remove the "if (threadnum) ..." test.
163  */
164 #define LOCK_SV_MUTEX                   \
165     STMT_START {                        \
166         if (threadnum)                  \
167             MUTEX_LOCK(&sv_mutex);      \
168     } STMT_END
169
170 #define UNLOCK_SV_MUTEX                 \
171     STMT_START {                        \
172         if (threadnum)                  \
173             MUTEX_UNLOCK(&sv_mutex);    \
174     } STMT_END
175
176 #ifndef THREAD_RET_TYPE
177 #  define THREAD_RET_TYPE       void *
178 #  define THREAD_RET_CAST(p)    ((void *)(p))
179 #endif /* THREAD_RET */
180
181
182 /* Values and macros for thr->flags */
183 #define THRf_STATE_MASK 7
184 #define THRf_R_JOINABLE 0
185 #define THRf_R_JOINED   1
186 #define THRf_R_DETACHED 2
187 #define THRf_ZOMBIE     3
188 #define THRf_DEAD       4
189
190 #define THRf_DID_DIE    8
191
192 /* ThrSTATE(t) and ThrSETSTATE(t) must only be called while holding t->mutex */
193 #define ThrSTATE(t) ((t)->flags & THRf_STATE_MASK)
194 #define ThrSETSTATE(t, s) STMT_START {          \
195         (t)->flags &= ~THRf_STATE_MASK;         \
196         (t)->flags |= (s);                      \
197         DEBUG_L(PerlIO_printf(PerlIO_stderr(),  \
198                               "thread %p set to state %d\n", (t), (s))); \
199     } STMT_END
200
201 typedef struct condpair {
202     perl_mutex  mutex;          /* Protects all other fields */
203     perl_cond   owner_cond;     /* For when owner changes at all */
204     perl_cond   cond;           /* For cond_signal and cond_broadcast */
205     Thread      owner;          /* Currently owning thread */
206 } condpair_t;
207
208 #define MgMUTEXP(mg) (&((condpair_t *)(mg->mg_ptr))->mutex)
209 #define MgOWNERCONDP(mg) (&((condpair_t *)(mg->mg_ptr))->owner_cond)
210 #define MgCONDP(mg) (&((condpair_t *)(mg->mg_ptr))->cond)
211 #define MgOWNER(mg) ((condpair_t *)(mg->mg_ptr))->owner
212
213 #else
214 /* USE_THREADS is not defined */
215 #define MUTEX_LOCK(m)
216 #define MUTEX_UNLOCK(m)
217 #define MUTEX_INIT(m)
218 #define MUTEX_DESTROY(m)
219 #define COND_INIT(c)
220 #define COND_SIGNAL(c)
221 #define COND_BROADCAST(c)
222 #define COND_WAIT(c, m)
223 #define COND_DESTROY(c)
224 #define LOCK_SV_MUTEX
225 #define UNLOCK_SV_MUTEX
226
227 #define THR
228 /* Rats: if dTHR is just blank then the subsequent ";" throws an error */
229 #ifdef WIN32
230 #define dTHR extern int Perl___notused
231 #else
232 #define dTHR extern int errno
233 #endif
234 #endif /* USE_THREADS */