ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/Coro-Multicore/Multicore.xs
(Generate patch)

Comparing Coro-Multicore/Multicore.xs (file contents):
Revision 1.21 by root, Sun Aug 26 15:30:55 2018 UTC vs.
Revision 1.29 by root, Tue Aug 3 14:15:39 2021 UTC

… …
27 27
28#ifndef SvREFCNT_dec_NN 28#ifndef SvREFCNT_dec_NN
29 #define SvREFCNT_dec_NN(sv) SvREFCNT_dec (sv) 29 #define SvREFCNT_dec_NN(sv) SvREFCNT_dec (sv)
30#endif 30#endif
31 31
32#ifndef SvREFCNT_dec_simple_void_NN
33 #define SvREFCNT_dec_simple_void_NN(sv) SvREFCNT_dec (sv)
34#endif
35
32#ifndef SvREFCNT_inc_NN 36#ifndef SvREFCNT_inc_NN
33 #define SvREFCNT_inc_NN(sv) SvREFCNT_inc (sv) 37 #define SvREFCNT_inc_NN(sv) SvREFCNT_inc (sv)
34#endif 38#endif
35 39
40#ifndef RECURSION_CHECK
36#define RECURSION_CHECK 0 41 #define RECURSION_CHECK 0
42#endif
37 43
38static X_TLS_DECLARE(current_key); 44static X_TLS_DECLARE(current_key);
39#if RECURSION_CHECK 45#if RECURSION_CHECK
40static X_TLS_DECLARE(check_key); 46static X_TLS_DECLARE(check_key);
41#endif 47#endif
42 48
49static void
50fatal (const char *msg)
51{
52 write (2, msg, strlen (msg));
53 abort ();
54}
43 55
44static s_epipe ep; 56static s_epipe ep;
45static void *perl_thx; 57static void *perl_thx;
46static sigset_t cursigset, fullsigset; 58static sigset_t cursigset, fullsigset;
47 59
… …
177static void 189static void
178start_thread (void) 190start_thread (void)
179{ 191{
180 xthread_t tid; 192 xthread_t tid;
181 193
194 if (!curthreads)
195 {
196 X_UNLOCK (release_m);
197 {
198 dTHX;
199 dSP;
200
201 PUSHSTACKi (PERLSI_REQUIRE);
202
203 eval_pv ("Coro::Multicore::init", 1);
204
205 POPSTACK;
206 }
207 X_LOCK (release_m);
208 }
209
182 if (curthreads >= max_threads && 0) 210 if (curthreads >= max_threads && 0)
183 return; 211 return;
184 212
185 ++curthreads; 213 ++curthreads;
186 ++idle; 214 ++idle;
… …
188} 216}
189 217
190static void 218static void
191pmapi_release (void) 219pmapi_release (void)
192{ 220{
221 if (! ((thread_enable ? thread_enable : global_enable) & 1))
222 {
223 X_TLS_SET (current_key, 0);
224 return;
225 }
226
193 #if RECURSION_CHECK 227 #if RECURSION_CHECK
194 if (X_TLS_GET (check_key)) 228 if (X_TLS_GET (check_key))
195 croak ("perlinterp_release () called without valid perl context"); 229 fatal ("FATAL: perlinterp_release () called without valid perl context");
196 230
197 X_TLS_SET (check_key, &check_key); 231 X_TLS_SET (check_key, &check_key);
198 #endif 232 #endif
199
200 if (! ((thread_enable ? thread_enable : global_enable) & 1))
201 {
202 X_TLS_SET (current_key, 0);
203 return;
204 }
205 233
206 struct tctx *ctx = tctx_get (); 234 struct tctx *ctx = tctx_get ();
207 ctx->coro = SvREFCNT_inc_simple_NN (CORO_CURRENT); 235 ctx->coro = SvREFCNT_inc_simple_NN (CORO_CURRENT);
208 ctx->wait_f = 0; 236 ctx->wait_f = 0;
209 237
… …
231pmapi_acquire (void) 259pmapi_acquire (void)
232{ 260{
233 int jeret; 261 int jeret;
234 struct tctx *ctx = X_TLS_GET (current_key); 262 struct tctx *ctx = X_TLS_GET (current_key);
235 263
264 if (!ctx)
265 return;
266
236 #if RECURSION_CHECK 267 #if RECURSION_CHECK
237 if (X_TLS_GET (check_key) != &check_key) 268 if (X_TLS_GET (check_key) != &check_key)
238 croak ("perlinterp_acquire () called with valid perl context"); 269 fatal ("FATAL: perlinterp_acquire () called with valid perl context");
239 270
240 X_TLS_SET (check_key, 0); 271 X_TLS_SET (check_key, 0);
241 #endif 272 #endif
242
243 if (!ctx)
244 return;
245 273
246 X_LOCK (acquire_m); 274 X_LOCK (acquire_m);
247 275
248 tctxs_put (&acquirers, ctx); 276 tctxs_put (&acquirers, ctx);
249 277
… …
267set_thread_enable (pTHX_ void *arg) 295set_thread_enable (pTHX_ void *arg)
268{ 296{
269 thread_enable = PTR2IV (arg); 297 thread_enable = PTR2IV (arg);
270} 298}
271 299
300static void
301atfork_child (void)
302{
303 s_epipe_renew (&ep);
304}
305
272MODULE = Coro::Multicore PACKAGE = Coro::Multicore 306MODULE = Coro::Multicore PACKAGE = Coro::Multicore
273 307
274PROTOTYPES: DISABLE 308PROTOTYPES: DISABLE
275 309
276BOOT: 310BOOT:
… …
285#endif 319#endif
286 320
287 if (s_epipe_new (&ep)) 321 if (s_epipe_new (&ep))
288 croak ("Coro::Multicore: unable to initialise event pipe.\n"); 322 croak ("Coro::Multicore: unable to initialise event pipe.\n");
289 323
324 pthread_atfork (0, 0, atfork_child);
325
290 perl_thx = PERL_GET_CONTEXT; 326 perl_thx = PERL_GET_CONTEXT;
291 327
292 I_CORO_API ("Coro::Multicore"); 328 I_CORO_API ("Coro::Multicore");
293 329
330 if (0) { /*D*/
294 X_LOCK (release_m); 331 X_LOCK (release_m);
295 while (idle < min_idle) 332 while (idle < min_idle)
296 start_thread (); 333 start_thread ();
297 X_UNLOCK (release_m); 334 X_UNLOCK (release_m);
335 }
298 336
299 /* not perfectly efficient to do it this way, but it is simple */ 337 /* not perfectly efficient to do it this way, but it is simple */
300 perl_multicore_init (); /* calls release */ 338 perl_multicore_init (); /* calls release */
301 perl_multicore_api->pmapi_release = pmapi_release; 339 perl_multicore_api->pmapi_release = pmapi_release;
302 perl_multicore_api->pmapi_acquire = pmapi_acquire; 340 perl_multicore_api->pmapi_acquire = pmapi_acquire;
… …
322scoped_disable () 360scoped_disable ()
323 CODE: 361 CODE:
324 LEAVE; /* see Guard.xs */ 362 LEAVE; /* see Guard.xs */
325 CORO_ENTERLEAVE_SCOPE_HOOK (set_thread_enable, (void *)2, set_thread_enable, (void *)0); 363 CORO_ENTERLEAVE_SCOPE_HOOK (set_thread_enable, (void *)2, set_thread_enable, (void *)0);
326 ENTER; /* see Guard.xs */ 364 ENTER; /* see Guard.xs */
365
366#if 0
327 367
328U32 368U32
329min_idle_threads (U32 min = NO_INIT) 369min_idle_threads (U32 min = NO_INIT)
330 CODE: 370 CODE:
331 X_LOCK (acquire_m); 371 X_LOCK (acquire_m);
… …
333 if (items) 373 if (items)
334 min_idle = min; 374 min_idle = min;
335 X_UNLOCK (acquire_m); 375 X_UNLOCK (acquire_m);
336 OUTPUT: 376 OUTPUT:
337 RETVAL 377 RETVAL
338 378
379#endif
339 380
340int 381int
341fd () 382fd ()
342 CODE: 383 CODE:
343 RETVAL = s_epipe_fd (&ep); 384 RETVAL = s_epipe_fd (&ep);
… …
351 X_LOCK (acquire_m); 392 X_LOCK (acquire_m);
352 while (acquirers.cur) 393 while (acquirers.cur)
353 { 394 {
354 struct tctx *ctx = tctxs_get (&acquirers); 395 struct tctx *ctx = tctxs_get (&acquirers);
355 CORO_READY ((SV *)ctx->coro); 396 CORO_READY ((SV *)ctx->coro);
356 SvREFCNT_dec_NN ((SV *)ctx->coro); 397 SvREFCNT_dec_simple_void_NN ((SV *)ctx->coro);
357 ctx->coro = 0; 398 ctx->coro = 0;
358 } 399 }
359 X_UNLOCK (acquire_m); 400 X_UNLOCK (acquire_m);
360 401
361void 402void

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines