]> git.vpit.fr Git - perl/modules/Scope-Upper.git/blob - xsh/threads.h
Temporarily rename xsh_debug_log to su_debug_log
[perl/modules/Scope-Upper.git] / xsh / threads.h
1 #ifndef XSH_THREADS_H
2 #define XSH_THREADS_H 1
3
4 #include "caps.h" /* XSH_HAS_PERL(), XSH_THREADSAFE */
5 #include "util.h" /* XSH_PACKAGE, dNOOP, NOOP */
6
7 #ifndef XSH_THREADS_COMPILE_TIME_PROTECTION
8 # define XSH_THREADS_COMPILE_TIME_PROTECTION 0
9 #endif
10
11 #ifndef XSH_THREADS_USER_CONTEXT
12 # define XSH_THREADS_USER_CONTEXT 1
13 #endif
14
15 #ifndef XSH_THREADS_USER_GLOBAL_SETUP
16 # define XSH_THREADS_USER_GLOBAL_SETUP 1
17 #endif
18
19 #ifndef XSH_THREADS_USER_LOCAL_SETUP
20 # define XSH_THREADS_USER_LOCAL_SETUP 1
21 #endif
22
23 #ifndef XSH_THREADS_USER_LOCAL_TEARDOWN
24 # define XSH_THREADS_USER_LOCAL_TEARDOWN 1
25 #endif
26
27 #ifndef XSH_THREADS_USER_GLOBAL_TEARDOWN
28 # define XSH_THREADS_USER_GLOBAL_TEARDOWN 1
29 #endif
30
31 #ifndef XSH_THREADS_PEEP_CONTEXT
32 # define XSH_THREADS_PEEP_CONTEXT 0
33 #endif
34
35 #ifndef XSH_THREADS_HINTS_CONTEXT
36 # define XSH_THREADS_HINTS_CONTEXT 0
37 #endif
38
39 #ifndef XSH_THREADS_USER_CLONE_NEEDS_DUP
40 # define XSH_THREADS_USER_CLONE_NEEDS_DUP 0
41 #endif
42
43 #if XSH_THREADSAFE && (XSH_THREADS_HINTS_CONTEXT || XSH_THREADS_USER_CLONE_NEEDS_DUP)
44 # define XSH_THREADS_CLONE_NEEDS_DUP 1
45 #else
46 # define XSH_THREADS_CLONE_NEEDS_DUP 0
47 #endif
48
49 #if defined(XSH_OPS_H) && (!XSH_THREADS_GLOBAL_SETUP || !XSH_THREADS_GLOBAL_TEARDOWN)
50 # error settting up hook check functions require global setup/teardown
51 #endif
52
53 #ifndef XSH_THREADS_NEED_TEARDOWN_LATE
54 # define XSH_THREADS_NEED_TEARDOWN_LATE 0
55 #endif
56
57 #if XSH_THREADS_NEED_TEARDOWN_LATE && (!XSH_THREADS_USER_LOCAL_TEARDOWN || !XSH_THREADS_USER_GLOBAL_TEARDOWN)
58 # error you need to declare local or global teardown handlers to use the late teardown feature
59 #endif
60
61 #if XSH_THREADSAFE
62 # ifndef MY_CXT_CLONE
63 #  define MY_CXT_CLONE \
64     dMY_CXT_SV;                                                      \
65     my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1)); \
66     Copy(INT2PTR(my_cxt_t*, SvUV(my_cxt_sv)), my_cxtp, 1, my_cxt_t); \
67     sv_setuv(my_cxt_sv, PTR2UV(my_cxtp))
68 # endif
69 #else
70 # undef  dMY_CXT
71 # define dMY_CXT      dNOOP
72 # undef  MY_CXT
73 # define MY_CXT       xsh_globaldata
74 # undef  START_MY_CXT
75 # define START_MY_CXT static my_cxt_t MY_CXT;
76 # undef  MY_CXT_INIT
77 # define MY_CXT_INIT  NOOP
78 # undef  MY_CXT_CLONE
79 # define MY_CXT_CLONE NOOP
80 #endif
81
82 #if XSH_THREADSAFE
83 /* We must use preexistent global mutexes or we will never be able to destroy
84  * them. */
85 # if XSH_HAS_PERL(5, 9, 3)
86 #  define XSH_LOADED_LOCK   MUTEX_LOCK(&PL_my_ctx_mutex)
87 #  define XSH_LOADED_UNLOCK MUTEX_UNLOCK(&PL_my_ctx_mutex)
88 # else
89 #  define XSH_LOADED_LOCK   OP_REFCNT_LOCK
90 #  define XSH_LOADED_UNLOCK OP_REFCNT_UNLOCK
91 # endif
92 #else
93 # define XSH_LOADED_LOCK   NOOP
94 # define XSH_LOADED_UNLOCK NOOP
95 #endif
96
97 static I32 xsh_loaded = 0;
98
99 #if XSH_THREADSAFE && XSH_THREADS_COMPILE_TIME_PROTECTION
100
101 #define PTABLE_USE_DEFAULT 1
102
103 #include "ptable.h"
104
105 #define ptable_loaded_store(T, K, V) ptable_default_store(aPTBL_ (T), (K), (V))
106 #define ptable_loaded_delete(T, K)   ptable_default_delete(aPTBL_ (T), (K))
107 #define ptable_loaded_free(T)        ptable_default_free(aPTBL_ (T))
108
109 static ptable *xsh_loaded_cxts = NULL;
110
111 static int xsh_is_loaded(pTHX_ void *cxt) {
112 #define xsh_is_loaded(C) xsh_is_loaded(aTHX_ (C))
113  int res = 0;
114
115  XSH_LOADED_LOCK;
116  if (xsh_loaded_cxts && ptable_fetch(xsh_loaded_cxts, cxt))
117   res = 1;
118  XSH_LOADED_UNLOCK;
119
120  return res;
121 }
122
123 static int xsh_set_loaded_locked(pTHX_ void *cxt) {
124 #define xsh_set_loaded_locked(C) xsh_set_loaded_locked(aTHX_ (C))
125  int global_setup = 0;
126
127  if (xsh_loaded <= 0) {
128   XSH_ASSERT(xsh_loaded == 0);
129   XSH_ASSERT(!xsh_loaded_cxts);
130   xsh_loaded_cxts = ptable_new(4);
131   global_setup   = 1;
132  }
133  ++xsh_loaded;
134  XSH_ASSERT(xsh_loaded_cxts);
135  ptable_loaded_store(xsh_loaded_cxts, cxt, cxt);
136
137  return global_setup;
138 }
139
140 static int xsh_clear_loaded_locked(pTHX_ void *cxt) {
141 #define xsh_clear_loaded_locked(C) xsh_clear_loaded_locked(aTHX_ (C))
142  int global_teardown = 0;
143
144  if (xsh_loaded > 1) {
145   XSH_ASSERT(xsh_loaded_cxts);
146   ptable_loaded_delete(xsh_loaded_cxts, cxt);
147   --xsh_loaded;
148  } else if (xsh_loaded_cxts) {
149   XSH_ASSERT(xsh_loaded == 1);
150   ptable_loaded_free(xsh_loaded_cxts);
151   xsh_loaded_cxts = NULL;
152   xsh_loaded      = 0;
153   global_teardown = 1;
154  }
155
156  return global_teardown;
157 }
158
159 #else  /*  XSH_THREADS_COMPILE_TIME_PROTECTION */
160
161 #define xsh_is_loaded_locked(C)    (xsh_loaded > 0)
162 #define xsh_set_loaded_locked(C)   ((xsh_loaded++ <= 0) ? 1 : 0)
163 #define xsh_clear_loaded_locked(C) ((--xsh_loaded <= 0) ? 1 : 0)
164
165 #if XSH_THREADSAFE
166
167 static int xsh_is_loaded(pTHX_ void *cxt) {
168 #define xsh_is_loaded(C) xsh_is_loaded(aTHX_ (C))
169  int res = 0;
170
171  XSH_LOADED_LOCK;
172  res = xsh_is_loaded_locked(cxt);
173  XSH_LOADED_UNLOCK;
174
175  return res;
176 }
177
178 #else
179
180 #define xsh_is_loaded(C) xsh_is_loaded_locked(C)
181
182 #endif
183
184 #endif /* !XSH_THREADS_COMPILE_TIME_PROTECTION */
185
186 #define MY_CXT_KEY XSH_PACKAGE "::_guts" XS_VERSION
187
188 typedef struct {
189 #if XSH_THREADS_USER_CONTEXT
190  xsh_user_cxt_t  cxt_user;
191 #endif
192 #if XSH_THREADS_PEEP_CONTEXT
193  xsh_peep_cxt_t  cxt_peep;
194 #endif
195 #if XSH_THREADS_HINTS_CONTEXT
196  xsh_hints_cxt_t cxt_hints;
197 #endif
198 #if XSH_THREADS_CLONE_NEEDS_DUP
199  tTHX            owner;
200 #endif
201 #if !(XSH_THREADS_USER_CONTEXT || XSH_THREADS_PEEP_CONTEXT || XSH_THREADS_HINTS_CONTEXT || XSH_THREADS_CLONE_NEEDS_DUP)
202  int             dummy;
203 #endif
204 } my_cxt_t;
205
206 START_MY_CXT
207
208 #if XSH_THREADS_USER_CONTEXT
209 # define dXSH_CXT dMY_CXT
210 # define XSH_CXT  (MY_CXT.cxt_user)
211 #endif
212
213 #if XSH_THREADS_USER_GLOBAL_SETUP
214 static void xsh_user_global_setup(pTHX);
215 #endif
216
217 #if XSH_THREADS_USER_LOCAL_SETUP
218 # if XSH_THREADS_USER_CONTEXT
219 static void xsh_user_local_setup(pTHX_ xsh_user_cxt_t *cxt);
220 # else
221 static void xsh_user_local_setup(pTHX);
222 # endif
223 #endif
224
225 #if XSH_THREADS_USER_LOCAL_TEARDOWN
226 # if XSH_THREADS_USER_CONTEXT
227 static void xsh_user_local_teardown(pTHX_ xsh_user_cxt_t *cxt);
228 # else
229 static void xsh_user_local_teardown(pTHX);
230 # endif
231 #endif
232
233 #if XSH_THREADS_USER_GLOBAL_TEARDOWN
234 static void xsh_user_global_teardown(pTHX);
235 #endif
236
237 #if XSH_THREADSAFE && XSH_THREADS_USER_CONTEXT
238 # if XSH_THREADS_USER_CLONE_NEEDS_DUP
239 static void xsh_user_clone(pTHX_ const xsh_user_cxt_t *old_cxt, xsh_user_cxt_t *new_cxt, CLONE_PARAMS *params);
240 # else
241 static void xsh_user_clone(pTHX_ const xsh_user_cxt_t *old_cxt, xsh_user_cxt_t *new_cxt);
242 # endif
243 #endif
244
245 #if XSH_THREADS_PEEP_CONTEXT
246 static xsh_peep_cxt_t *xsh_peep_get_cxt(pTHX) {
247  dMY_CXT;
248  XSH_ASSERT(xsh_is_loaded(&MY_CXT));
249  return &MY_CXT.cxt_peep;
250 }
251 #endif
252
253 #if XSH_THREADS_HINTS_CONTEXT
254 static xsh_hints_cxt_t *xsh_hints_get_cxt(pTHX) {
255  dMY_CXT;
256  XSH_ASSERT(xsh_is_loaded(&MY_CXT));
257  return &MY_CXT.cxt_hints;
258 }
259 #endif
260
261 #if XSH_THREADS_NEED_TEARDOWN_LATE
262
263 typedef void (*xsh_teardown_late_cb)(pTHX_ void *ud);
264
265 static int xsh_teardown_late_simple_free(pTHX_ SV *sv, MAGIC *mg) {
266  xsh_teardown_late_cb cb;
267
268  cb = DPTR2FPTR(xsh_teardown_late_cb, mg->mg_ptr);
269
270  XSH_LOADED_LOCK;
271  if (xsh_loaded == 0)
272   cb(aTHX_ NULL);
273  XSH_LOADED_UNLOCK;
274
275  return 0;
276 }
277
278 static MGVTBL xsh_teardown_late_simple_vtbl = {
279  0,
280  0,
281  0,
282  0,
283  xsh_teardown_late_simple_free
284 #if MGf_COPY
285  , 0
286 #endif
287 #if MGf_DUP
288  , 0
289 #endif
290 #if MGf_LOCAL
291  , 0
292 #endif
293 };
294
295 typedef struct {
296  xsh_teardown_late_cb  cb;
297  void                 *ud;
298 } xsh_teardown_late_token;
299
300 static int xsh_teardown_late_arg_free(pTHX_ SV *sv, MAGIC *mg) {
301  xsh_teardown_late_token *tok;
302
303  tok = (xsh_teardown_late_token *) mg->mg_ptr;
304
305  XSH_LOADED_LOCK;
306  if (xsh_loaded == 0)
307   tok->cb(aTHX_ tok->ud);
308  XSH_LOADED_UNLOCK;
309
310  PerlMemShared_free(tok);
311
312  return 0;
313 }
314
315 static MGVTBL xsh_teardown_late_arg_vtbl = {
316  0,
317  0,
318  0,
319  0,
320  xsh_teardown_late_arg_free
321 #if MGf_COPY
322  , 0
323 #endif
324 #if MGf_DUP
325  , 0
326 #endif
327 #if MGf_LOCAL
328  , 0
329 #endif
330 };
331
332 static void xsh_teardown_late_register(pTHX_ xsh_teardown_late_cb cb, void *ud){
333 #define xsh_teardown_late_register(CB, UD) xsh_teardown_late_register(aTHX_ (CB), (UD))
334  void *ptr;
335
336  if (!ud) {
337   ptr = FPTR2DPTR(void *, cb);
338  } else {
339   xsh_teardown_late_token *tok;
340
341   tok     = PerlMemShared_malloc(sizeof *tok);
342   tok->cb = cb;
343   tok->ud = ud;
344
345   ptr = tok;
346  }
347
348  if (!PL_strtab)
349   PL_strtab = newHV();
350
351  sv_magicext((SV *) PL_strtab, NULL, PERL_MAGIC_ext,
352              ud ? &xsh_teardown_late_arg_vtbl : &xsh_teardown_late_simple_vtbl,
353              ptr, 0);
354
355  return;
356 }
357
358 #endif /* XSH_THREADS_NEED_TEARDOWN_LATE */
359
360 static void xsh_teardown(pTHX_ void *root) {
361  dMY_CXT;
362
363 #if XSH_THREADS_USER_LOCAL_TEARDOWN
364 # if XSH_THREADS_USER_CONTEXT
365  xsh_user_local_teardown(aTHX_ &XSH_CXT);
366 # else
367  xsh_user_local_teardown(aTHX);
368 # endif
369 #endif
370
371 #if XSH_THREADS_PEEP_CONTEXT
372  xsh_peep_local_teardown(aTHX_ &MY_CXT.cxt_peep);
373 #endif
374
375 #if XSH_THREADS_HINTS_CONTEXT
376  xsh_hints_local_teardown(aTHX_ &MY_CXT.cxt_hints);
377 #endif
378
379  XSH_LOADED_LOCK;
380
381  if (xsh_clear_loaded_locked(&MY_CXT)) {
382 #if XSH_THREADS_USER_GLOBAL_TEARDOWN
383   xsh_user_global_teardown(aTHX);
384 #endif
385
386 #if XSH_THREADS_HINTS_CONTEXT
387   xsh_hints_global_teardown(aTHX);
388 #endif
389  }
390
391  XSH_LOADED_UNLOCK;
392
393  return;
394 }
395
396 static void xsh_setup(pTHX) {
397 #define xsh_setup() xsh_setup(aTHX)
398  MY_CXT_INIT; /* Takes/release PL_my_ctx_mutex */
399
400  XSH_LOADED_LOCK;
401
402  if (xsh_set_loaded_locked(&MY_CXT)) {
403 #if XSH_THREADS_HINTS_CONTEXT
404   xsh_hints_global_setup(aTHX);
405 #endif
406
407 #if XSH_THREADS_USER_GLOBAL_SETUP
408   xsh_user_global_setup(aTHX);
409 #endif
410  }
411
412  XSH_LOADED_UNLOCK;
413
414 #if XSH_THREADS_CLONE_NEEDS_DUP
415  MY_CXT.owner = aTHX;
416 #endif
417
418 #if XSH_THREADS_HINTS_CONTEXT
419  xsh_hints_local_setup(aTHX_ &MY_CXT.cxt_hints);
420 #endif
421
422 #if XSH_THREADS_PEEP_CONTEXT
423  xsh_peep_local_setup(aTHX_ &MY_CXT.cxt_peep);
424 #endif
425
426 #if XSH_THREADS_USER_LOCAL_SETUP
427 # if XSH_THREADS_USER_CONTEXT
428  xsh_user_local_setup(aTHX_ &XSH_CXT);
429 # else
430  xsh_user_local_setup(aTHX);
431 # endif
432 #endif
433
434  call_atexit(xsh_teardown, NULL);
435
436  return;
437 }
438
439 #if XSH_THREADSAFE
440
441 static void xsh_clone(pTHX) {
442 #define xsh_clone() xsh_clone(aTHX)
443  const my_cxt_t *old_cxt;
444  my_cxt_t       *new_cxt;
445
446  {
447   dMY_CXT;
448   old_cxt = &MY_CXT;
449  }
450
451  {
452   int global_setup;
453
454   MY_CXT_CLONE;
455   new_cxt = &MY_CXT;
456
457   XSH_LOADED_LOCK;
458   global_setup = xsh_set_loaded_locked(new_cxt);
459   XSH_ASSERT(!global_setup);
460   XSH_LOADED_UNLOCK;
461
462 #if XSH_THREADS_CLONE_NEEDS_DUP
463   new_cxt->owner = aTHX;
464 #endif
465  }
466
467  {
468 #if XSH_THREADS_CLONE_NEEDS_DUP
469   XSH_DUP_PARAMS_TYPE params;
470   xsh_dup_params_init(params, old_cxt->owner);
471 #endif
472
473 #if XSH_THREADS_PEEP_CONTEXT
474   xsh_peep_clone(aTHX_ &old_cxt->cxt_peep, &new_cxt->cxt_peep);
475 #endif
476
477 #if XSH_THREADS_HINTS_CONTEXT
478   xsh_hints_clone(aTHX_ &old_cxt->cxt_hints, &new_cxt->cxt_hints,
479                         xsh_dup_params_ptr(params));
480 #endif
481
482 #if XSH_THREADS_USER_CONTEXT
483 # if XSH_THREADS_USER_CLONE_NEEDS_DUP
484   xsh_user_clone(aTHX_ &old_cxt->cxt_user, &new_cxt->cxt_user,
485                        xsh_dup_params_ptr(params));
486 # else
487   xsh_user_clone(aTHX_ &old_cxt->cxt_user, &new_cxt->cxt_user);
488 # endif
489 #endif
490
491 #if XSH_THREADS_CLONE_NEEDS_DUP
492   xsh_dup_params_deinit(params);
493 #endif
494  }
495
496  return;
497 }
498
499 #endif /* XSH_THREADSAFE */
500
501 #endif /* XSH_THREADS_H */