This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
AIX patch (including Configure support for {sched,pthread}_yield,
[perl5.git] / thread.h
1 #ifdef USE_THREADS
2
3 #ifdef WIN32
4 #  include <win32thread.h>
5 #else
6
7 /* POSIXish threads */
8 typedef pthread_t perl_os_thread;
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 #  define pthread_attr_default NULL
25 #endif /* OLD_PTHREADS_API */
26 #endif
27
28 #ifndef YIELD
29 #  ifdef HAS_PTHREAD_YIELD
30 #    define YIELD pthread_yield()
31 #  else
32 #    define YIELD sched_yield()
33 #  endif
34 #endif
35
36 #ifndef MUTEX_INIT
37 #define MUTEX_INIT(m)                                           \
38     STMT_START {                                                \
39         if (pthread_mutex_init((m), pthread_mutexattr_default)) \
40             croak("panic: MUTEX_INIT");                         \
41     } STMT_END
42 #define MUTEX_LOCK(m)                           \
43     STMT_START {                                \
44         if (pthread_mutex_lock((m)))            \
45             croak("panic: MUTEX_LOCK");         \
46     } STMT_END
47 #define MUTEX_UNLOCK(m)                         \
48     STMT_START {                                \
49         if (pthread_mutex_unlock((m)))          \
50             croak("panic: MUTEX_UNLOCK");       \
51     } STMT_END
52 #define MUTEX_DESTROY(m)                        \
53     STMT_START {                                \
54         if (pthread_mutex_destroy((m)))         \
55             croak("panic: MUTEX_DESTROY");      \
56     } STMT_END
57 #endif /* MUTEX_INIT */
58
59 #ifndef COND_INIT
60 #define COND_INIT(c)                                            \
61     STMT_START {                                                \
62         if (pthread_cond_init((c), pthread_condattr_default))   \
63             croak("panic: COND_INIT");                          \
64     } STMT_END
65 #define COND_SIGNAL(c)                          \
66     STMT_START {                                \
67         if (pthread_cond_signal((c)))           \
68             croak("panic: COND_SIGNAL");        \
69     } STMT_END
70 #define COND_BROADCAST(c)                       \
71     STMT_START {                                \
72         if (pthread_cond_broadcast((c)))        \
73             croak("panic: COND_BROADCAST");     \
74     } STMT_END
75 #define COND_WAIT(c, m)                         \
76     STMT_START {                                \
77         if (pthread_cond_wait((c), (m)))        \
78             croak("panic: COND_WAIT");          \
79     } STMT_END
80 #define COND_DESTROY(c)                         \
81     STMT_START {                                \
82         if (pthread_cond_destroy((c)))          \
83             croak("panic: COND_DESTROY");       \
84     } STMT_END
85 #endif /* COND_INIT */
86
87 /* DETACH(t) must only be called while holding t->mutex */
88 #ifndef DETACH
89 #define DETACH(t)                               \
90     STMT_START {                                \
91         if (pthread_detach((t)->self)) {        \
92             MUTEX_UNLOCK(&(t)->mutex);          \
93             croak("panic: DETACH");             \
94         }                                       \
95     } STMT_END
96 #endif /* DETACH */
97
98 #ifndef JOIN
99 #define JOIN(t, avp)                                    \
100     STMT_START {                                        \
101         if (pthread_join((t)->self, (void**)(avp)))     \
102             croak("panic: pthread_join");               \
103     } STMT_END
104 #endif /* JOIN */
105
106 #ifndef SET_THR
107 #define SET_THR(t)                                      \
108     STMT_START {                                        \
109         if (pthread_setspecific(thr_key, (void *) (t))) \
110             croak("panic: pthread_setspecific");        \
111     } STMT_END
112 #endif /* SET_THR */
113
114 #ifndef THR
115 #  ifdef OLD_PTHREADS_API
116 struct perl_thread *getTHR _((void));
117 #    define THR getTHR()
118 #  else
119 #    define THR ((struct perl_thread *) pthread_getspecific(thr_key))
120 #  endif /* OLD_PTHREADS_API */
121 #endif /* THR */
122
123 #ifndef dTHR
124 #  define dTHR struct perl_thread *thr = THR
125 #endif /* dTHR */
126
127 #ifndef INIT_THREADS
128 #  ifdef NEED_PTHREAD_INIT
129 #    define INIT_THREADS pthread_init()
130 #  else
131 #    define INIT_THREADS NOOP
132 #  endif
133 #endif
134
135
136 #ifndef THREAD_RET_TYPE
137 #  define THREAD_RET_TYPE       void *
138 #  define THREAD_RET_CAST(p)    ((void *)(p))
139 #endif /* THREAD_RET */
140
141 struct perl_thread {
142     /* The fields that used to be global */
143     /* Important ones in the first cache line (if alignment is done right) */
144     SV **       Tstack_sp;
145 #ifdef OP_IN_REGISTER
146     OP *        Topsave;
147 #else
148     OP *        Top;
149 #endif
150     SV **       Tcurpad;
151     SV **       Tstack_base;
152
153     SV **       Tstack_max;
154
155     I32 *       Tscopestack;
156     I32         Tscopestack_ix;
157     I32         Tscopestack_max;
158
159     ANY *       Tsavestack;
160     I32         Tsavestack_ix;
161     I32         Tsavestack_max;
162
163     OP **       Tretstack;
164     I32         Tretstack_ix;
165     I32         Tretstack_max;
166
167     I32 *       Tmarkstack;
168     I32 *       Tmarkstack_ptr;
169     I32 *       Tmarkstack_max;
170
171     SV *        TSv;
172     XPV *       TXpv;
173     struct stat Tstatbuf;
174     struct tms  Ttimesbuf;
175     
176     /* XXX What about regexp stuff? */
177
178     /* Now the fields that used to be "per interpreter" (even when global) */
179
180     /* Fields used by magic variables such as $@, $/ and so on */
181     bool        Ttainted;
182     PMOP *      Tcurpm;
183     SV *        Tnrs;
184     SV *        Trs;
185     GV *        Tlast_in_gv;
186     char *      Tofs;
187     STRLEN      Tofslen;
188     GV *        Tdefoutgv;
189     char *      Tchopset;
190     SV *        Tformtarget;
191     SV *        Tbodytarget;
192     SV *        Ttoptarget;
193
194     /* Stashes */
195     HV *        Tdefstash;
196     HV *        Tcurstash;
197
198     /* Stacks */
199     SV **       Ttmps_stack;
200     I32         Ttmps_ix;
201     I32         Ttmps_floor;
202     I32         Ttmps_max;
203
204     int         Tin_eval;
205     OP *        Trestartop;
206     int         Tdelaymagic;
207     bool        Tdirty;
208     U8          Tlocalizing;
209     COP *       Tcurcop;
210
211     PERL_CONTEXT *      Tcxstack;
212     I32         Tcxstack_ix;
213     I32         Tcxstack_max;
214
215     AV *        Tcurstack;
216     AV *        Tmainstack;
217     JMPENV *    Ttop_env;
218
219     /* XXX Sort stuff, firstgv, secongv and so on? */
220
221     SV *        oursv;
222     HV *        cvcache;
223     perl_os_thread      self;           /* Underlying thread object */
224     U32         flags;
225     AV *        threadsv;               /* Per-thread SVs ($_, $@ etc.) */
226     AV *        specific;               /* Thread-specific user data */
227     SV *        errsv;                  /* Backing SV for $@ */
228     HV *        errhv;                  /* HV for what was %@ in pp_ctl.c */
229     perl_mutex  mutex;                  /* For the fields others can change */
230     U32         tid;
231     struct perl_thread *next, *prev;            /* Circular linked list of threads */
232     JMPENV      Tstart_env;             /* Top of top_env longjmp() chain */ 
233 #ifdef HAVE_THREAD_INTERN
234     struct thread_intern i;             /* Platform-dependent internals */
235 #endif
236     char        trailing_nul;           /* For the sake of thrsv and oursv */
237 };
238
239 typedef struct perl_thread *Thread;
240
241 /* Values and macros for thr->flags */
242 #define THRf_STATE_MASK 7
243 #define THRf_R_JOINABLE 0
244 #define THRf_R_JOINED   1
245 #define THRf_R_DETACHED 2
246 #define THRf_ZOMBIE     3
247 #define THRf_DEAD       4
248
249 #define THRf_DID_DIE    8
250
251 /* ThrSTATE(t) and ThrSETSTATE(t) must only be called while holding t->mutex */
252 #define ThrSTATE(t) ((t)->flags & THRf_STATE_MASK)
253 #define ThrSETSTATE(t, s) STMT_START {          \
254         (t)->flags &= ~THRf_STATE_MASK;         \
255         (t)->flags |= (s);                      \
256         DEBUG_L(PerlIO_printf(PerlIO_stderr(),  \
257                               "thread %p set to state %d\n", (t), (s))); \
258     } STMT_END
259
260 typedef struct condpair {
261     perl_mutex  mutex;          /* Protects all other fields */
262     perl_cond   owner_cond;     /* For when owner changes at all */
263     perl_cond   cond;           /* For cond_signal and cond_broadcast */
264     Thread      owner;          /* Currently owning thread */
265 } condpair_t;
266
267 #define MgMUTEXP(mg) (&((condpair_t *)(mg->mg_ptr))->mutex)
268 #define MgOWNERCONDP(mg) (&((condpair_t *)(mg->mg_ptr))->owner_cond)
269 #define MgCONDP(mg) (&((condpair_t *)(mg->mg_ptr))->cond)
270 #define MgOWNER(mg) ((condpair_t *)(mg->mg_ptr))->owner
271
272 #undef  stack_base
273 #undef  stack_sp
274 #undef  stack_max
275 #undef  curstack
276 #undef  mainstack
277 #undef  markstack
278 #undef  markstack_ptr
279 #undef  markstack_max
280 #undef  scopestack
281 #undef  scopestack_ix
282 #undef  scopestack_max
283 #undef  savestack
284 #undef  savestack_ix
285 #undef  savestack_max
286 #undef  retstack
287 #undef  retstack_ix
288 #undef  retstack_max
289 #undef  curcop
290 #undef  cxstack
291 #undef  cxstack_ix
292 #undef  cxstack_max
293 #undef  defstash
294 #undef  curstash
295 #undef  tmps_stack
296 #undef  tmps_floor
297 #undef  tmps_ix
298 #undef  tmps_max
299 #undef  curpad
300 #undef  Sv
301 #undef  Xpv
302 #undef  statbuf
303 #undef  timesbuf
304 #undef  tainted
305 #undef  curpm
306 #undef  nrs
307 #undef  rs
308 #undef  last_in_gv
309 #undef  ofs
310 #undef  ofslen
311 #undef  defoutgv
312 #undef  chopset
313 #undef  formtarget
314 #undef  bodytarget
315 #undef  start_env
316 #undef  toptarget
317 #undef  top_env
318 #undef  in_eval
319 #undef  restartop
320 #undef  delaymagic
321 #undef  dirty
322 #undef  localizing
323
324 #define stack_base      (thr->Tstack_base)
325 #define stack_sp        (thr->Tstack_sp)
326 #define stack_max       (thr->Tstack_max)
327 #ifdef OP_IN_REGISTER
328 #define opsave          (thr->Topsave)
329 #else
330 #undef  op
331 #define op              (thr->Top)
332 #endif
333 #define curcop          (thr->Tcurcop)
334 #define stack           (thr->Tstack)
335 #define curstack        (thr->Tcurstack)
336 #define mainstack       (thr->Tmainstack)
337 #define markstack       (thr->Tmarkstack)
338 #define markstack_ptr   (thr->Tmarkstack_ptr)
339 #define markstack_max   (thr->Tmarkstack_max)
340 #define scopestack      (thr->Tscopestack)
341 #define scopestack_ix   (thr->Tscopestack_ix)
342 #define scopestack_max  (thr->Tscopestack_max)
343
344 #define savestack       (thr->Tsavestack)
345 #define savestack_ix    (thr->Tsavestack_ix)
346 #define savestack_max   (thr->Tsavestack_max)
347
348 #define retstack        (thr->Tretstack)
349 #define retstack_ix     (thr->Tretstack_ix)
350 #define retstack_max    (thr->Tretstack_max)
351
352 #define cxstack         (thr->Tcxstack)
353 #define cxstack_ix      (thr->Tcxstack_ix)
354 #define cxstack_max     (thr->Tcxstack_max)
355
356 #define curpad          (thr->Tcurpad)
357 #define Sv              (thr->TSv)
358 #define Xpv             (thr->TXpv)
359 #define statbuf         (thr->Tstatbuf)
360 #define timesbuf        (thr->Ttimesbuf)
361 #define tainted         (thr->Ttainted)
362 #define tainted         (thr->Ttainted)
363 #define curpm           (thr->Tcurpm)
364 #define nrs             (thr->Tnrs)
365 #define rs              (thr->Trs)
366 #define last_in_gv      (thr->Tlast_in_gv)
367 #define ofs             (thr->Tofs)
368 #define ofslen          (thr->Tofslen)
369 #define defoutgv        (thr->Tdefoutgv)
370 #define chopset         (thr->Tchopset)
371 #define formtarget      (thr->Tformtarget)
372 #define bodytarget      (thr->Tbodytarget)
373 #define toptarget       (thr->Ttoptarget)
374 #define defstash        (thr->Tdefstash)
375 #define curstash        (thr->Tcurstash)
376
377 #define tmps_stack      (thr->Ttmps_stack)
378 #define tmps_ix         (thr->Ttmps_ix)
379 #define tmps_floor      (thr->Ttmps_floor)
380 #define tmps_max        (thr->Ttmps_max)
381
382 #define in_eval         (thr->Tin_eval)
383 #define restartop       (thr->Trestartop)
384 #define delaymagic      (thr->Tdelaymagic)
385 #define dirty           (thr->Tdirty)
386 #define localizing      (thr->Tlocalizing)
387
388 #define top_env         (thr->Ttop_env)
389 #define start_env       (thr->Tstart_env)
390
391 #else
392 /* USE_THREADS is not defined */
393 #define MUTEX_LOCK(m)
394 #define MUTEX_UNLOCK(m)
395 #define MUTEX_INIT(m)
396 #define MUTEX_DESTROY(m)
397 #define COND_INIT(c)
398 #define COND_SIGNAL(c)
399 #define COND_BROADCAST(c)
400 #define COND_WAIT(c, m)
401 #define COND_DESTROY(c)
402
403 #define THR
404 /* Rats: if dTHR is just blank then the subsequent ";" throws an error */
405 #define dTHR extern int errno
406 #endif /* USE_THREADS */