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

Comparing Coro/Coro/State.xs (file contents):
Revision 1.327 by root, Mon Nov 24 06:07:16 2008 UTC vs.
Revision 1.334 by root, Fri Nov 28 23:30:55 2008 UTC

… …
133#else 133#else
134# define dSTACKLEVEL volatile void *stacklevel 134# define dSTACKLEVEL volatile void *stacklevel
135# define STACKLEVEL ((void *)&stacklevel) 135# define STACKLEVEL ((void *)&stacklevel)
136#endif 136#endif
137 137
138#define IN_DESTRUCT (PL_main_cv == Nullcv) 138#define IN_DESTRUCT PL_dirty
139 139
140#if __GNUC__ >= 3 140#if __GNUC__ >= 3
141# define attribute(x) __attribute__(x) 141# define attribute(x) __attribute__(x)
142# define expect(expr,value) __builtin_expect ((expr),(value)) 142# define expect(expr,value) __builtin_expect ((expr),(value))
143# define INLINE static inline 143# define INLINE static inline
… …
355 HV *st; 355 HV *st;
356 GV *gvp; 356 GV *gvp;
357 return sv_2cv (sv, &st, &gvp, 0); 357 return sv_2cv (sv, &st, &gvp, 0);
358} 358}
359 359
360/*****************************************************************************/
361/* magic glue */
362
363#define CORO_MAGIC_type_cv 26
364#define CORO_MAGIC_type_state PERL_MAGIC_ext
365
366#define CORO_MAGIC_NN(sv, type) \
367 (expect_true (SvMAGIC (sv)->mg_type == type) \
368 ? SvMAGIC (sv) \
369 : mg_find (sv, type))
370
371#define CORO_MAGIC(sv, type) \
372 (expect_true (SvMAGIC (sv)) \
373 ? CORO_MAGIC_NN (sv, type) \
374 : 0)
375
376#define CORO_MAGIC_cv(cv) CORO_MAGIC (((SV *)(cv)), CORO_MAGIC_type_cv)
377#define CORO_MAGIC_state(sv) CORO_MAGIC_NN (((SV *)(sv)), CORO_MAGIC_type_state)
378
379INLINE struct coro *
380SvSTATE_ (pTHX_ SV *coro)
381{
382 HV *stash;
383 MAGIC *mg;
384
385 if (SvROK (coro))
386 coro = SvRV (coro);
387
388 if (expect_false (SvTYPE (coro) != SVt_PVHV))
389 croak ("Coro::State object required");
390
391 stash = SvSTASH (coro);
392 if (expect_false (stash != coro_stash && stash != coro_state_stash))
393 {
394 /* very slow, but rare, check */
395 if (!sv_derived_from (sv_2mortal (newRV_inc (coro)), "Coro::State"))
396 croak ("Coro::State object required");
397 }
398
399 mg = CORO_MAGIC_state (coro);
400 return (struct coro *)mg->mg_ptr;
401}
402
403#define SvSTATE(sv) SvSTATE_ (aTHX_ (sv))
404
405/* faster than SvSTATE, but expects a coroutine hv */
406#define SvSTATE_hv(hv) ((struct coro *)CORO_MAGIC_NN ((SV *)hv, CORO_MAGIC_type_state)->mg_ptr)
407#define SvSTATE_current SvSTATE_hv (SvRV (coro_current))
408
409/*****************************************************************************/
410/* padlist management and caching */
411
360static AV * 412static AV *
361coro_derive_padlist (pTHX_ CV *cv) 413coro_derive_padlist (pTHX_ CV *cv)
362{ 414{
363 AV *padlist = CvPADLIST (cv); 415 AV *padlist = CvPADLIST (cv);
364 AV *newpadlist, *newpad; 416 AV *newpadlist, *newpad;
… …
371 Perl_pad_push (aTHX_ padlist, AvFILLp (padlist) + 1, 1); 423 Perl_pad_push (aTHX_ padlist, AvFILLp (padlist) + 1, 1);
372#endif 424#endif
373 newpad = (AV *)AvARRAY (padlist)[AvFILLp (padlist)]; 425 newpad = (AV *)AvARRAY (padlist)[AvFILLp (padlist)];
374 --AvFILLp (padlist); 426 --AvFILLp (padlist);
375 427
376 av_store (newpadlist, 0, SvREFCNT_inc_NN (*av_fetch (padlist, 0, FALSE))); 428 av_store (newpadlist, 0, SvREFCNT_inc_NN (AvARRAY (padlist)[0]));
377 av_store (newpadlist, 1, (SV *)newpad); 429 av_store (newpadlist, 1, (SV *)newpad);
378 430
379 return newpadlist; 431 return newpadlist;
380} 432}
381 433
382static void 434static void
383free_padlist (pTHX_ AV *padlist) 435free_padlist (pTHX_ AV *padlist)
384{ 436{
385 /* may be during global destruction */ 437 /* may be during global destruction */
386 if (SvREFCNT (padlist)) 438 if (!IN_DESTRUCT)
387 { 439 {
388 I32 i = AvFILLp (padlist); 440 I32 i = AvFILLp (padlist);
389 while (i >= 0) 441
442 while (i > 0) /* special-case index 0 */
390 { 443 {
391 SV **svp = av_fetch (padlist, i--, FALSE); 444 /* we try to be extra-careful here */
392 if (svp) 445 AV *av = (AV *)AvARRAY (padlist)[i--];
393 { 446 I32 j = AvFILLp (av);
394 SV *sv; 447
395 while (&PL_sv_undef != (sv = av_pop ((AV *)*svp))) 448 while (j >= 0)
449 SvREFCNT_dec (AvARRAY (av)[j--]);
450
451 AvFILLp (av) = -1;
396 SvREFCNT_dec (sv); 452 SvREFCNT_dec (av);
397
398 SvREFCNT_dec (*svp);
399 }
400 } 453 }
401 454
455 SvREFCNT_dec (AvARRAY (padlist)[0]);
456
457 AvFILLp (padlist) = -1;
402 SvREFCNT_dec ((SV*)padlist); 458 SvREFCNT_dec ((SV*)padlist);
403 } 459 }
404} 460}
405 461
406static int 462static int
… …
415 471
416 SvREFCNT_dec (av); /* sv_magicext increased the refcount */ 472 SvREFCNT_dec (av); /* sv_magicext increased the refcount */
417 473
418 return 0; 474 return 0;
419} 475}
420
421#define CORO_MAGIC_type_cv 26
422#define CORO_MAGIC_type_state PERL_MAGIC_ext
423 476
424static MGVTBL coro_cv_vtbl = { 477static MGVTBL coro_cv_vtbl = {
425 0, 0, 0, 0, 478 0, 0, 0, 0,
426 coro_cv_free 479 coro_cv_free
427}; 480};
428
429#define CORO_MAGIC_NN(sv, type) \
430 (expect_true (SvMAGIC (sv)->mg_type == type) \
431 ? SvMAGIC (sv) \
432 : mg_find (sv, type))
433
434#define CORO_MAGIC(sv, type) \
435 (expect_true (SvMAGIC (sv)) \
436 ? CORO_MAGIC_NN (sv, type) \
437 : 0)
438
439#define CORO_MAGIC_cv(cv) CORO_MAGIC (((SV *)(cv)), CORO_MAGIC_type_cv)
440#define CORO_MAGIC_state(sv) CORO_MAGIC_NN (((SV *)(sv)), CORO_MAGIC_type_state)
441
442INLINE struct coro *
443SvSTATE_ (pTHX_ SV *coro)
444{
445 HV *stash;
446 MAGIC *mg;
447
448 if (SvROK (coro))
449 coro = SvRV (coro);
450
451 if (expect_false (SvTYPE (coro) != SVt_PVHV))
452 croak ("Coro::State object required");
453
454 stash = SvSTASH (coro);
455 if (expect_false (stash != coro_stash && stash != coro_state_stash))
456 {
457 /* very slow, but rare, check */
458 if (!sv_derived_from (sv_2mortal (newRV_inc (coro)), "Coro::State"))
459 croak ("Coro::State object required");
460 }
461
462 mg = CORO_MAGIC_state (coro);
463 return (struct coro *)mg->mg_ptr;
464}
465
466#define SvSTATE(sv) SvSTATE_ (aTHX_ (sv))
467
468/* faster than SvSTATE, but expects a coroutine hv */
469#define SvSTATE_hv(hv) ((struct coro *)CORO_MAGIC_NN ((SV *)hv, CORO_MAGIC_type_state)->mg_ptr)
470#define SvSTATE_current SvSTATE_hv (SvRV (coro_current))
471 481
472/* the next two functions merely cache the padlists */ 482/* the next two functions merely cache the padlists */
473static void 483static void
474get_padlist (pTHX_ CV *cv) 484get_padlist (pTHX_ CV *cv)
475{ 485{
… …
503 mg = sv_magicext ((SV *)cv, (SV *)newAV (), CORO_MAGIC_type_cv, &coro_cv_vtbl, 0, 0); 513 mg = sv_magicext ((SV *)cv, (SV *)newAV (), CORO_MAGIC_type_cv, &coro_cv_vtbl, 0, 0);
504 514
505 av = (AV *)mg->mg_obj; 515 av = (AV *)mg->mg_obj;
506 516
507 if (expect_false (AvFILLp (av) >= AvMAX (av))) 517 if (expect_false (AvFILLp (av) >= AvMAX (av)))
508 av_extend (av, AvMAX (av) + 1); 518 av_extend (av, AvFILLp (av) + 1);
509 519
510 AvARRAY (av)[++AvFILLp (av)] = (SV *)CvPADLIST (cv); 520 AvARRAY (av)[++AvFILLp (av)] = (SV *)CvPADLIST (cv);
511} 521}
512 522
513/** load & save, init *******************************************************/ 523/** load & save, init *******************************************************/
… …
928 /* copy throw, in case it was set before coro_setup */ 938 /* copy throw, in case it was set before coro_setup */
929 CORO_THROW = coro->except; 939 CORO_THROW = coro->except;
930} 940}
931 941
932static void 942static void
933coro_destruct (pTHX_ struct coro *coro) 943coro_destruct_perl (pTHX_ struct coro *coro)
934{ 944{
935 if (!IN_DESTRUCT) 945 if (!IN_DESTRUCT)
936 { 946 {
937 /* restore all saved variables and stuff */ 947 /* restore all saved variables and stuff */
938 LEAVE_SCOPE (0); 948 LEAVE_SCOPE (0);
… …
1178 /* 1188 /*
1179 * If perl-run returns we assume exit() was being called or the coro 1189 * If perl-run returns we assume exit() was being called or the coro
1180 * fell off the end, which seems to be the only valid (non-bug) 1190 * fell off the end, which seems to be the only valid (non-bug)
1181 * reason for perl_run to return. We try to exit by jumping to the 1191 * reason for perl_run to return. We try to exit by jumping to the
1182 * bootstrap-time "top" top_env, as we cannot restore the "main" 1192 * bootstrap-time "top" top_env, as we cannot restore the "main"
1183 * coroutine as Coro has no such concept 1193 * coroutine as Coro has no such concept.
1194 * This actually isn't valid with the pthread backend, but OSes requiring
1195 * that backend are too broken to do it in a standards-compliant way.
1184 */ 1196 */
1185 PL_top_env = main_top_env; 1197 PL_top_env = main_top_env;
1186 JMPENV_JUMP (2); /* I do not feel well about the hardcoded 2 at all */ 1198 JMPENV_JUMP (2); /* I do not feel well about the hardcoded 2 at all */
1187 } 1199 }
1188} 1200}
… …
1459 --coro_nready; 1471 --coro_nready;
1460 } 1472 }
1461 else 1473 else
1462 coro->flags |= CF_READY; /* make sure it is NOT put into the readyqueue */ 1474 coro->flags |= CF_READY; /* make sure it is NOT put into the readyqueue */
1463 1475
1464 if (coro->mainstack && coro->mainstack != main_mainstack) 1476 if (coro->mainstack
1477 && coro->mainstack != main_mainstack
1478 && !PL_dirty)
1465 { 1479 {
1466 struct coro temp; 1480 struct coro temp;
1467 1481
1468 assert (("FATAL: tried to destroy currently running coroutine (please report)", !(coro->flags & CF_RUNNING))); 1482 assert (("FATAL: tried to destroy currently running coroutine (please report)", !(coro->flags & CF_RUNNING)));
1469 1483
1470 save_perl (aTHX_ &temp); 1484 save_perl (aTHX_ &temp);
1471 load_perl (aTHX_ coro); 1485 load_perl (aTHX_ coro);
1472 1486
1473 coro_destruct (aTHX_ coro); 1487 coro_destruct_perl (aTHX_ coro);
1474 1488
1475 load_perl (aTHX_ &temp); 1489 load_perl (aTHX_ &temp);
1476 1490
1477 coro->slot = 0; 1491 coro->slot = 0;
1478 } 1492 }
… …
2368 SV **ary; 2382 SV **ary;
2369 2383
2370 /* unfortunately, building manually saves memory */ 2384 /* unfortunately, building manually saves memory */
2371 Newx (ary, 2, SV *); 2385 Newx (ary, 2, SV *);
2372 AvALLOC (av) = ary; 2386 AvALLOC (av) = ary;
2387#if PERL_VERSION_ATLEAST (5,10,0)
2373 /*AvARRAY (av) = ary;*/ 2388 AvARRAY (av) = ary;
2389#else
2374 SvPVX ((SV *)av) = (char *)ary; /* 5.8.8 needs this syntax instead of AvARRAY = ary */ 2390 /* 5.8.8 needs this syntax instead of AvARRAY = ary, yet */
2391 /* -DDEBUGGING flags this as a bug, despite it perfectly working */
2392 SvPVX ((SV *)av) = (char *)ary;
2393#endif
2375 AvMAX (av) = 1; 2394 AvMAX (av) = 1;
2376 AvFILLp (av) = 0; 2395 AvFILLp (av) = 0;
2377 ary [0] = newSViv (count); 2396 ary [0] = newSViv (count);
2378 2397
2379 return newRV_noinc ((SV *)av); 2398 return newRV_noinc ((SV *)av);
… …
2908SV * 2927SV *
2909clone (Coro::State coro) 2928clone (Coro::State coro)
2910 CODE: 2929 CODE:
2911{ 2930{
2912#if CORO_CLONE 2931#if CORO_CLONE
2913 struct coro *ncoro = coro_clone (coro); 2932 struct coro *ncoro = coro_clone (aTHX_ coro);
2914 MAGIC *mg; 2933 MAGIC *mg;
2915 /* TODO: too much duplication */ 2934 /* TODO: too much duplication */
2916 ncoro->hv = newHV (); 2935 ncoro->hv = newHV ();
2917 mg = sv_magicext ((SV *)ncoro->hv, 0, CORO_MAGIC_type_state, &coro_state_vtbl, (char *)ncoro, 0); 2936 mg = sv_magicext ((SV *)ncoro->hv, 0, CORO_MAGIC_type_state, &coro_state_vtbl, (char *)ncoro, 0);
2918 mg->mg_flags |= MGf_DUP; 2937 mg->mg_flags |= MGf_DUP;

Diff Legend

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