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.300 by root, Wed Nov 19 02:07:48 2008 UTC vs.
Revision 1.318 by root, Thu Nov 20 07:02:43 2008 UTC

16 16
17#ifdef WIN32 17#ifdef WIN32
18# undef setjmp 18# undef setjmp
19# undef longjmp 19# undef longjmp
20# undef _exit 20# undef _exit
21# define setjmp _setjmp // deep magic, don't ask 21# define setjmp _setjmp /* deep magic */
22#else 22#else
23# include <inttypes.h> /* most portable stdint.h */ 23# include <inttypes.h> /* most portable stdint.h */
24#endif 24#endif
25 25
26#ifdef HAVE_MMAP 26#ifdef HAVE_MMAP
55 55
56#define PERL_VERSION_ATLEAST(a,b,c) \ 56#define PERL_VERSION_ATLEAST(a,b,c) \
57 (PERL_REVISION > (a) \ 57 (PERL_REVISION > (a) \
58 || (PERL_REVISION == (a) \ 58 || (PERL_REVISION == (a) \
59 && (PERL_VERSION > (b) \ 59 && (PERL_VERSION > (b) \
60 || (PERL_VERSION == (b) && PERLSUBVERSION >= (c))))) 60 || (PERL_VERSION == (b) && PERL_SUBVERSION >= (c)))))
61 61
62#if !PERL_VERSION_ATLEAST (5,6,0) 62#if !PERL_VERSION_ATLEAST (5,6,0)
63# ifndef PL_ppaddr 63# ifndef PL_ppaddr
64# define PL_ppaddr ppaddr 64# define PL_ppaddr ppaddr
65# endif 65# endif
98# define newSV(l) NEWSV(0,l) 98# define newSV(l) NEWSV(0,l)
99#endif 99#endif
100#ifndef CvISXSUB_on 100#ifndef CvISXSUB_on
101# define CvISXSUB_on(cv) (void)cv 101# define CvISXSUB_on(cv) (void)cv
102#endif 102#endif
103#ifndef CvISXSUB
104# define CvISXSUB(cv) (CvXSUB (cv) ? TRUE : FALSE)
105#endif
103 106
104/* 5.8.7 */ 107/* 5.8.7 */
105#ifndef SvRV_set 108#ifndef SvRV_set
106# define SvRV_set(s,v) SvRV(s) = (v) 109# define SvRV_set(s,v) SvRV(s) = (v)
107#endif 110#endif
167static AV *main_mainstack; /* used to differentiate between $main and others */ 170static AV *main_mainstack; /* used to differentiate between $main and others */
168static JMPENV *main_top_env; 171static JMPENV *main_top_env;
169static HV *coro_state_stash, *coro_stash; 172static HV *coro_state_stash, *coro_stash;
170static volatile SV *coro_mortal; /* will be freed/thrown after next transfer */ 173static volatile SV *coro_mortal; /* will be freed/thrown after next transfer */
171 174
175static AV *av_destroy; /* destruction queue */
176static SV *sv_manager; /* the manager coro */
177
172static GV *irsgv; /* $/ */ 178static GV *irsgv; /* $/ */
173static GV *stdoutgv; /* *STDOUT */ 179static GV *stdoutgv; /* *STDOUT */
174static SV *rv_diehook; 180static SV *rv_diehook;
175static SV *rv_warnhook; 181static SV *rv_warnhook;
176static HV *hv_sig; /* %SIG */ 182static HV *hv_sig; /* %SIG */
177 183
178/* async_pool helper stuff */ 184/* async_pool helper stuff */
179static SV *sv_pool_rss; 185static SV *sv_pool_rss;
180static SV *sv_pool_size; 186static SV *sv_pool_size;
187static SV *sv_async_pool_idle; /* description string */
181static AV *av_async_pool; 188static AV *av_async_pool; /* idle pool */
189static SV *sv_Coro; /* class string */
190static CV *cv_pool_handler;
191static CV *cv_coro_state_new;
182 192
183/* Coro::AnyEvent */ 193/* Coro::AnyEvent */
184static SV *sv_activity; 194static SV *sv_activity;
185 195
186static struct coro_cctx *cctx_first; 196static struct coro_cctx *cctx_first;
246 /* state data */ 256 /* state data */
247 struct CoroSLF slf_frame; /* saved slf frame */ 257 struct CoroSLF slf_frame; /* saved slf frame */
248 AV *mainstack; 258 AV *mainstack;
249 perl_slots *slot; /* basically the saved sp */ 259 perl_slots *slot; /* basically the saved sp */
250 260
261 CV *startcv; /* the CV to execute */
251 AV *args; /* data associated with this coroutine (initial args) */ 262 AV *args; /* data associated with this coroutine (initial args) */
252 int refcnt; /* coroutines are refcounted, yes */ 263 int refcnt; /* coroutines are refcounted, yes */
253 int flags; /* CF_ flags */ 264 int flags; /* CF_ flags */
254 HV *hv; /* the perl hash associated with this coro, if any */ 265 HV *hv; /* the perl hash associated with this coro, if any */
255 void (*on_destroy)(pTHX_ struct coro *coro); 266 void (*on_destroy)(pTHX_ struct coro *coro);
256 267
257 /* statistics */ 268 /* statistics */
258 int usecount; /* number of transfers to this coro */ 269 int usecount; /* number of transfers to this coro */
259 270
260 /* coro process data */ 271 /* coro process data */
261 int prio; 272 int prio;
262 SV *except; /* exception to be thrown */ 273 SV *except; /* exception to be thrown */
274 SV *rouse_cb;
263 275
264 /* async_pool */ 276 /* async_pool */
265 SV *saved_deffh; 277 SV *saved_deffh;
278 SV *invoke_cb;
279 AV *invoke_av;
266 280
267 /* linked list */ 281 /* linked list */
268 struct coro *next, *prev; 282 struct coro *next, *prev;
269}; 283};
270 284
287 301
288/* for Coro.pm */ 302/* for Coro.pm */
289static SV *coro_current; 303static SV *coro_current;
290static SV *coro_readyhook; 304static SV *coro_readyhook;
291static AV *coro_ready [PRIO_MAX - PRIO_MIN + 1]; 305static AV *coro_ready [PRIO_MAX - PRIO_MIN + 1];
306static CV *cv_coro_run, *cv_coro_terminate;
292static struct coro *coro_first; 307static struct coro *coro_first;
293#define coro_nready coroapi.nready 308#define coro_nready coroapi.nready
294 309
295/** lowlevel stuff **********************************************************/ 310/** lowlevel stuff **********************************************************/
296 311
320#if PERL_VERSION_ATLEAST (5,10,0) 335#if PERL_VERSION_ATLEAST (5,10,0)
321 /* silence stupid and wrong 5.10 warning that I am unable to switch off */ 336 /* silence stupid and wrong 5.10 warning that I am unable to switch off */
322 get_hv (name, create); 337 get_hv (name, create);
323#endif 338#endif
324 return get_hv (name, create); 339 return get_hv (name, create);
340}
341
342/* may croak */
343INLINE CV *
344coro_sv_2cv (pTHX_ SV *sv)
345{
346 HV *st;
347 GV *gvp;
348 return sv_2cv (sv, &st, &gvp, 0);
325} 349}
326 350
327static AV * 351static AV *
328coro_clone_padlist (pTHX_ CV *cv) 352coro_clone_padlist (pTHX_ CV *cv)
329{ 353{
448 else 472 else
449 { 473 {
450#if CORO_PREFER_PERL_FUNCTIONS 474#if CORO_PREFER_PERL_FUNCTIONS
451 /* this is probably cleaner? but also slower! */ 475 /* this is probably cleaner? but also slower! */
452 /* in practise, it seems to be less stable */ 476 /* in practise, it seems to be less stable */
453 CV *cp = Perl_cv_clone (cv); 477 CV *cp = Perl_cv_clone (aTHX_ cv);
454 CvPADLIST (cv) = CvPADLIST (cp); 478 CvPADLIST (cv) = CvPADLIST (cp);
455 CvPADLIST (cp) = 0; 479 CvPADLIST (cp) = 0;
456 SvREFCNT_dec (cp); 480 SvREFCNT_dec (cp);
457#else 481#else
458 CvPADLIST (cv) = coro_clone_padlist (aTHX_ cv); 482 CvPADLIST (cv) = coro_clone_padlist (aTHX_ cv);
602 * of perl.c:init_stacks, except that it uses less memory 626 * of perl.c:init_stacks, except that it uses less memory
603 * on the (sometimes correct) assumption that coroutines do 627 * on the (sometimes correct) assumption that coroutines do
604 * not usually need a lot of stackspace. 628 * not usually need a lot of stackspace.
605 */ 629 */
606#if CORO_PREFER_PERL_FUNCTIONS 630#if CORO_PREFER_PERL_FUNCTIONS
607# define coro_init_stacks init_stacks 631# define coro_init_stacks(thx) init_stacks ()
608#else 632#else
609static void 633static void
610coro_init_stacks (pTHX) 634coro_init_stacks (pTHX)
611{ 635{
612 PL_curstackinfo = new_stackinfo(32, 8); 636 PL_curstackinfo = new_stackinfo(32, 8);
675#if !PERL_VERSION_ATLEAST (5,10,0) 699#if !PERL_VERSION_ATLEAST (5,10,0)
676 Safefree (PL_retstack); 700 Safefree (PL_retstack);
677#endif 701#endif
678} 702}
679 703
704#define CORO_RSS \
705 rss += sizeof (SYM (curstackinfo)); \
706 rss += (SYM (curstackinfo->si_cxmax) + 1) * sizeof (PERL_CONTEXT); \
707 rss += sizeof (SV) + sizeof (struct xpvav) + (1 + AvMAX (SYM (curstack))) * sizeof (SV *); \
708 rss += SYM (tmps_max) * sizeof (SV *); \
709 rss += (SYM (markstack_max) - SYM (markstack_ptr)) * sizeof (I32); \
710 rss += SYM (scopestack_max) * sizeof (I32); \
711 rss += SYM (savestack_max) * sizeof (ANY);
712
680static size_t 713static size_t
681coro_rss (pTHX_ struct coro *coro) 714coro_rss (pTHX_ struct coro *coro)
682{ 715{
683 size_t rss = sizeof (*coro); 716 size_t rss = sizeof (*coro);
684 717
685 if (coro->mainstack) 718 if (coro->mainstack)
686 { 719 {
687 perl_slots tmp_slot;
688 perl_slots *slot;
689
690 if (coro->flags & CF_RUNNING) 720 if (coro->flags & CF_RUNNING)
691 { 721 {
692 slot = &tmp_slot; 722 #define SYM(sym) PL_ ## sym
693 723 CORO_RSS;
694 #define VAR(name,type) slot->name = PL_ ## name;
695 # include "state.h"
696 #undef VAR 724 #undef SYM
697 } 725 }
698 else 726 else
699 slot = coro->slot;
700
701 if (slot)
702 { 727 {
703 rss += sizeof (slot->curstackinfo); 728 #define SYM(sym) coro->slot->sym
704 rss += (slot->curstackinfo->si_cxmax + 1) * sizeof (PERL_CONTEXT); 729 CORO_RSS;
705 rss += sizeof (SV) + sizeof (struct xpvav) + (1 + AvMAX (slot->curstack)) * sizeof (SV *); 730 #undef SYM
706 rss += slot->tmps_max * sizeof (SV *);
707 rss += (slot->markstack_max - slot->markstack_ptr) * sizeof (I32);
708 rss += slot->scopestack_max * sizeof (I32);
709 rss += slot->savestack_max * sizeof (ANY);
710
711#if !PERL_VERSION_ATLEAST (5,10,0)
712 rss += slot->retstack_max * sizeof (OP *);
713#endif
714 } 731 }
715 } 732 }
716 733
717 return rss; 734 return rss;
718} 735}
818 835
819static int 836static int
820slf_check_nop (pTHX_ struct CoroSLF *frame) 837slf_check_nop (pTHX_ struct CoroSLF *frame)
821{ 838{
822 return 0; 839 return 0;
840}
841
842static int
843slf_check_repeat (pTHX_ struct CoroSLF *frame)
844{
845 return 1;
823} 846}
824 847
825static UNOP coro_setup_op; 848static UNOP coro_setup_op;
826 849
827static void NOINLINE /* noinline to keep it out of the transfer fast path */ 850static void NOINLINE /* noinline to keep it out of the transfer fast path */
860 dSP; 883 dSP;
861 UNOP myop; 884 UNOP myop;
862 885
863 Zero (&myop, 1, UNOP); 886 Zero (&myop, 1, UNOP);
864 myop.op_next = Nullop; 887 myop.op_next = Nullop;
888 myop.op_type = OP_ENTERSUB;
865 myop.op_flags = OPf_WANT_VOID; 889 myop.op_flags = OPf_WANT_VOID;
866 890
867 PUSHMARK (SP); 891 PUSHMARK (SP);
868 XPUSHs (sv_2mortal (av_shift (GvAV (PL_defgv)))); 892 PUSHs ((SV *)coro->startcv);
869 PUTBACK; 893 PUTBACK;
870 PL_op = (OP *)&myop; 894 PL_op = (OP *)&myop;
871 PL_op = PL_ppaddr[OP_ENTERSUB](aTHX); 895 PL_op = PL_ppaddr[OP_ENTERSUB](aTHX);
872 SPAGAIN;
873 } 896 }
874 897
875 /* this newly created coroutine might be run on an existing cctx which most 898 /* this newly created coroutine might be run on an existing cctx which most
876 * likely was suspended in pp_slf, so we have to emulate entering pp_slf here. 899 * likely was suspended in pp_slf, so we have to emulate entering pp_slf here.
877 */ 900 */
880 903
881 /* and we have to provide the pp_slf op in any case, so pp_slf can skip it */ 904 /* and we have to provide the pp_slf op in any case, so pp_slf can skip it */
882 coro_setup_op.op_next = PL_op; 905 coro_setup_op.op_next = PL_op;
883 coro_setup_op.op_type = OP_CUSTOM; 906 coro_setup_op.op_type = OP_CUSTOM;
884 coro_setup_op.op_ppaddr = pp_slf; 907 coro_setup_op.op_ppaddr = pp_slf;
885 /* no flags required, as an init function won't be called */ 908 /* no flags etc. required, as an init function won't be called */
886 909
887 PL_op = (OP *)&coro_setup_op; 910 PL_op = (OP *)&coro_setup_op;
888 911
889 /* copy throw, in case it was set before coro_setup */ 912 /* copy throw, in case it was set before coro_setup */
890 CORO_THROW = coro->except; 913 CORO_THROW = coro->except;
919 942
920 SvREFCNT_dec (PL_diehook); 943 SvREFCNT_dec (PL_diehook);
921 SvREFCNT_dec (PL_warnhook); 944 SvREFCNT_dec (PL_warnhook);
922 945
923 SvREFCNT_dec (coro->saved_deffh); 946 SvREFCNT_dec (coro->saved_deffh);
924 SvREFCNT_dec (CORO_THROW); 947 SvREFCNT_dec (coro->rouse_cb);
948 SvREFCNT_dec (coro->invoke_cb);
949 SvREFCNT_dec (coro->invoke_av);
925 950
926 coro_destruct_stacks (aTHX); 951 coro_destruct_stacks (aTHX);
927} 952}
928 953
929INLINE void 954INLINE void
1016 SAVETMPS; 1041 SAVETMPS;
1017 EXTEND (SP, 3); 1042 EXTEND (SP, 3);
1018 PUSHMARK (SP); 1043 PUSHMARK (SP);
1019 PUSHs (&PL_sv_yes); 1044 PUSHs (&PL_sv_yes);
1020 PUSHs (fullname); 1045 PUSHs (fullname);
1021 PUSHs (CxHASARGS (cx) ? sv_2mortal (newRV_inc ((SV *)cx->blk_sub.argarray)) : &PL_sv_undef); 1046 PUSHs (CxHASARGS (cx) ? sv_2mortal (newRV_inc ((SV *)cx->blk_sub.argarray)) : &PL_sv_undef);
1022 PUTBACK; 1047 PUTBACK;
1023 cb = hv_fetch ((HV *)SvRV (coro_current), "_trace_sub_cb", sizeof ("_trace_sub_cb") - 1, 0); 1048 cb = hv_fetch ((HV *)SvRV (coro_current), "_trace_sub_cb", sizeof ("_trace_sub_cb") - 1, 0);
1024 if (cb) call_sv (*cb, G_KEEPERR | G_EVAL | G_VOID | G_DISCARD); 1049 if (cb) call_sv (*cb, G_KEEPERR | G_EVAL | G_VOID | G_DISCARD);
1025 SPAGAIN; 1050 SPAGAIN;
1026 FREETMPS; 1051 FREETMPS;
1132 transfer_tail (aTHX); 1157 transfer_tail (aTHX);
1133 1158
1134 /* somebody or something will hit me for both perl_run and PL_restartop */ 1159 /* somebody or something will hit me for both perl_run and PL_restartop */
1135 PL_restartop = PL_op; 1160 PL_restartop = PL_op;
1136 perl_run (PL_curinterp); 1161 perl_run (PL_curinterp);
1162 /*
1163 * Unfortunately, there is no way to get at the return values of the
1164 * coro body here, as perl_run destroys these
1165 */
1137 1166
1138 /* 1167 /*
1139 * If perl-run returns we assume exit() was being called or the coro 1168 * If perl-run returns we assume exit() was being called or the coro
1140 * fell off the end, which seems to be the only valid (non-bug) 1169 * fell off the end, which seems to be the only valid (non-bug)
1141 * reason for perl_run to return. We try to exit by jumping to the 1170 * reason for perl_run to return. We try to exit by jumping to the
1433 1462
1434 coro->slot = 0; 1463 coro->slot = 0;
1435 } 1464 }
1436 1465
1437 cctx_destroy (coro->cctx); 1466 cctx_destroy (coro->cctx);
1467 SvREFCNT_dec (coro->startcv);
1438 SvREFCNT_dec (coro->args); 1468 SvREFCNT_dec (coro->args);
1469 SvREFCNT_dec (CORO_THROW);
1439 1470
1440 if (coro->next) coro->next->prev = coro->prev; 1471 if (coro->next) coro->next->prev = coro->prev;
1441 if (coro->prev) coro->prev->next = coro->next; 1472 if (coro->prev) coro->prev->next = coro->next;
1442 if (coro == coro_first) coro_first = coro->next; 1473 if (coro == coro_first) coro_first = coro->next;
1443 1474
1497 1528
1498 prepare_transfer (aTHX_ &ta, prev_sv, next_sv); 1529 prepare_transfer (aTHX_ &ta, prev_sv, next_sv);
1499 TRANSFER (ta, 1); 1530 TRANSFER (ta, 1);
1500} 1531}
1501 1532
1533/*****************************************************************************/
1534/* gensub: simple closure generation utility */
1535
1536#define GENSUB_ARG CvXSUBANY (cv).any_ptr
1537
1538/* create a closure from XS, returns a code reference */
1539/* the arg can be accessed via GENSUB_ARG from the callback */
1540/* the callback must use dXSARGS/XSRETURN */
1541static SV *
1542gensub (pTHX_ void (*xsub)(pTHX_ CV *), void *arg)
1543{
1544 CV *cv = (CV *)newSV (0);
1545
1546 sv_upgrade ((SV *)cv, SVt_PVCV);
1547
1548 CvANON_on (cv);
1549 CvISXSUB_on (cv);
1550 CvXSUB (cv) = xsub;
1551 GENSUB_ARG = arg;
1552
1553 return newRV_noinc ((SV *)cv);
1554}
1555
1502/** Coro ********************************************************************/ 1556/** Coro ********************************************************************/
1503 1557
1504INLINE void 1558INLINE void
1505coro_enq (pTHX_ struct coro *coro) 1559coro_enq (pTHX_ struct coro *coro)
1506{ 1560{
1567api_is_ready (pTHX_ SV *coro_sv) 1621api_is_ready (pTHX_ SV *coro_sv)
1568{ 1622{
1569 return !!(SvSTATE (coro_sv)->flags & CF_READY); 1623 return !!(SvSTATE (coro_sv)->flags & CF_READY);
1570} 1624}
1571 1625
1626/* expects to own a reference to next->hv */
1572INLINE void 1627INLINE void
1628prepare_schedule_to (pTHX_ struct coro_transfer_args *ta, struct coro *next)
1629{
1630 SV *prev_sv = SvRV (coro_current);
1631
1632 ta->prev = SvSTATE_hv (prev_sv);
1633 ta->next = next;
1634
1635 TRANSFER_CHECK (*ta);
1636
1637 SvRV_set (coro_current, (SV *)next->hv);
1638
1639 free_coro_mortal (aTHX);
1640 coro_mortal = prev_sv;
1641}
1642
1643static void
1573prepare_schedule (pTHX_ struct coro_transfer_args *ta) 1644prepare_schedule (pTHX_ struct coro_transfer_args *ta)
1574{ 1645{
1575 SV *prev_sv, *next_sv;
1576
1577 for (;;) 1646 for (;;)
1578 { 1647 {
1579 next_sv = coro_deq (aTHX); 1648 SV *next_sv = coro_deq (aTHX);
1580 1649
1581 /* nothing to schedule: call the idle handler */
1582 if (expect_false (!next_sv)) 1650 if (expect_true (next_sv))
1583 { 1651 {
1652 struct coro *next = SvSTATE_hv (next_sv);
1653
1654 /* cannot transfer to destroyed coros, skip and look for next */
1655 if (expect_false (next->flags & CF_DESTROYED))
1656 SvREFCNT_dec (next_sv); /* coro_nready has already been taken care of by destroy */
1657 else
1658 {
1659 next->flags &= ~CF_READY;
1660 --coro_nready;
1661
1662 return prepare_schedule_to (aTHX_ ta, next);
1663 }
1664 }
1665 else
1666 {
1667 /* nothing to schedule: call the idle handler */
1584 dSP; 1668 dSP;
1585 1669
1586 ENTER; 1670 ENTER;
1587 SAVETMPS; 1671 SAVETMPS;
1588 1672
1590 PUTBACK; 1674 PUTBACK;
1591 call_sv (get_sv ("Coro::idle", FALSE), G_VOID | G_DISCARD); 1675 call_sv (get_sv ("Coro::idle", FALSE), G_VOID | G_DISCARD);
1592 1676
1593 FREETMPS; 1677 FREETMPS;
1594 LEAVE; 1678 LEAVE;
1595 continue;
1596 } 1679 }
1597
1598 ta->next = SvSTATE_hv (next_sv);
1599
1600 /* cannot transfer to destroyed coros, skip and look for next */
1601 if (expect_false (ta->next->flags & CF_DESTROYED))
1602 {
1603 SvREFCNT_dec (next_sv);
1604 /* coro_nready has already been taken care of by destroy */
1605 continue;
1606 }
1607
1608 --coro_nready;
1609 break;
1610 } 1680 }
1611
1612 /* free this only after the transfer */
1613 prev_sv = SvRV (coro_current);
1614 ta->prev = SvSTATE_hv (prev_sv);
1615 TRANSFER_CHECK (*ta);
1616 assert (("FATAL: next coroutine isn't marked as ready in Coro (please report)", ta->next->flags & CF_READY));
1617 ta->next->flags &= ~CF_READY;
1618 SvRV_set (coro_current, next_sv);
1619
1620 free_coro_mortal (aTHX);
1621 coro_mortal = prev_sv;
1622} 1681}
1623 1682
1624INLINE void 1683INLINE void
1625prepare_cede (pTHX_ struct coro_transfer_args *ta) 1684prepare_cede (pTHX_ struct coro_transfer_args *ta)
1626{ 1685{
1647{ 1706{
1648 struct coro_transfer_args ta; 1707 struct coro_transfer_args ta;
1649 1708
1650 prepare_schedule (aTHX_ &ta); 1709 prepare_schedule (aTHX_ &ta);
1651 TRANSFER (ta, 1); 1710 TRANSFER (ta, 1);
1711}
1712
1713static void
1714api_schedule_to (pTHX_ SV *coro_sv)
1715{
1716 struct coro_transfer_args ta;
1717 struct coro *next = SvSTATE (coro_sv);
1718
1719 SvREFCNT_inc_NN (coro_sv);
1720 prepare_schedule_to (aTHX_ &ta, next);
1652} 1721}
1653 1722
1654static int 1723static int
1655api_cede (pTHX) 1724api_cede (pTHX)
1656{ 1725{
1703 if (coro->flags & CF_RUNNING) 1772 if (coro->flags & CF_RUNNING)
1704 PL_runops = RUNOPS_DEFAULT; 1773 PL_runops = RUNOPS_DEFAULT;
1705 else 1774 else
1706 coro->slot->runops = RUNOPS_DEFAULT; 1775 coro->slot->runops = RUNOPS_DEFAULT;
1707 } 1776 }
1777}
1778
1779static void
1780coro_call_on_destroy (pTHX_ struct coro *coro)
1781{
1782 SV **on_destroyp = hv_fetch (coro->hv, "_on_destroy", sizeof ("_on_destroy") - 1, 0);
1783 SV **statusp = hv_fetch (coro->hv, "_status", sizeof ("_status") - 1, 0);
1784
1785 if (on_destroyp)
1786 {
1787 AV *on_destroy = (AV *)SvRV (*on_destroyp);
1788
1789 while (AvFILLp (on_destroy) >= 0)
1790 {
1791 dSP; /* don't disturb outer sp */
1792 SV *cb = av_pop (on_destroy);
1793
1794 PUSHMARK (SP);
1795
1796 if (statusp)
1797 {
1798 int i;
1799 AV *status = (AV *)SvRV (*statusp);
1800 EXTEND (SP, AvFILLp (status) + 1);
1801
1802 for (i = 0; i <= AvFILLp (status); ++i)
1803 PUSHs (AvARRAY (status)[i]);
1804 }
1805
1806 PUTBACK;
1807 call_sv (sv_2mortal (cb), G_VOID | G_DISCARD);
1808 }
1809 }
1810}
1811
1812static void
1813slf_init_terminate (pTHX_ struct CoroSLF *frame, CV *cv, SV **arg, int items)
1814{
1815 int i;
1816 HV *hv = (HV *)SvRV (coro_current);
1817 AV *av = newAV ();
1818
1819 av_extend (av, items - 1);
1820 for (i = 0; i < items; ++i)
1821 av_push (av, SvREFCNT_inc_NN (arg [i]));
1822
1823 hv_store (hv, "_status", sizeof ("_status") - 1, newRV_noinc ((SV *)av), 0);
1824
1825 av_push (av_destroy, (SV *)newRV_inc ((SV *)hv)); /* RVinc for perl */
1826 api_ready (aTHX_ sv_manager);
1827
1828 frame->prepare = prepare_schedule;
1829 frame->check = slf_check_repeat;
1830}
1831
1832/*****************************************************************************/
1833/* async pool handler */
1834
1835static int
1836slf_check_pool_handler (pTHX_ struct CoroSLF *frame)
1837{
1838 HV *hv = (HV *)SvRV (coro_current);
1839 struct coro *coro = (struct coro *)frame->data;
1840
1841 if (!coro->invoke_cb)
1842 return 1; /* loop till we have invoke */
1843 else
1844 {
1845 hv_store (hv, "desc", sizeof ("desc") - 1,
1846 newSVpvn ("[async_pool]", sizeof ("[async_pool]") - 1), 0);
1847
1848 coro->saved_deffh = SvREFCNT_inc_NN ((SV *)PL_defoutgv);
1849
1850 {
1851 dSP;
1852 XPUSHs (sv_2mortal (coro->invoke_cb)); coro->invoke_cb = 0;
1853 PUTBACK;
1854 }
1855
1856 SvREFCNT_dec (GvAV (PL_defgv));
1857 GvAV (PL_defgv) = coro->invoke_av;
1858 coro->invoke_av = 0;
1859
1860 return 0;
1861 }
1862}
1863
1864static void
1865slf_init_pool_handler (pTHX_ struct CoroSLF *frame, CV *cv, SV **arg, int items)
1866{
1867 HV *hv = (HV *)SvRV (coro_current);
1868 struct coro *coro = SvSTATE_hv ((SV *)hv);
1869
1870 if (expect_true (coro->saved_deffh))
1871 {
1872 /* subsequent iteration */
1873 SvREFCNT_dec ((SV *)PL_defoutgv); PL_defoutgv = (GV *)coro->saved_deffh;
1874 coro->saved_deffh = 0;
1875
1876 if (coro_rss (aTHX_ coro) > SvUV (sv_pool_rss)
1877 || av_len (av_async_pool) + 1 >= SvIV (sv_pool_size))
1878 {
1879 coro->invoke_cb = SvREFCNT_inc_NN ((SV *)cv_coro_terminate);
1880 coro->invoke_av = newAV ();
1881
1882 frame->prepare = prepare_nop;
1883 }
1884 else
1885 {
1886 av_clear (GvAV (PL_defgv));
1887 hv_store (hv, "desc", sizeof ("desc") - 1, SvREFCNT_inc_NN (sv_async_pool_idle), 0);
1888
1889 coro->prio = 0;
1890
1891 if (coro->cctx && (coro->cctx->flags & CC_TRACE))
1892 api_trace (aTHX_ coro_current, 0);
1893
1894 frame->prepare = prepare_schedule;
1895 av_push (av_async_pool, SvREFCNT_inc (hv));
1896 }
1897 }
1898 else
1899 {
1900 /* first iteration, simply fall through */
1901 frame->prepare = prepare_nop;
1902 }
1903
1904 frame->check = slf_check_pool_handler;
1905 frame->data = (void *)coro;
1906}
1907
1908/*****************************************************************************/
1909/* rouse callback */
1910
1911#define CORO_MAGIC_type_rouse PERL_MAGIC_ext
1912
1913static void
1914coro_rouse_callback (pTHX_ CV *cv)
1915{
1916 dXSARGS;
1917 SV *data = (SV *)GENSUB_ARG;
1918
1919 if (SvTYPE (SvRV (data)) != SVt_PVAV)
1920 {
1921 /* first call, set args */
1922 AV *av = newAV ();
1923 SV *coro = SvRV (data);
1924
1925 SvRV_set (data, (SV *)av);
1926 api_ready (aTHX_ coro);
1927 SvREFCNT_dec (coro);
1928
1929 /* better take a full copy of the arguments */
1930 while (items--)
1931 av_store (av, items, newSVsv (ST (items)));
1932 }
1933
1934 XSRETURN_EMPTY;
1935}
1936
1937static int
1938slf_check_rouse_wait (pTHX_ struct CoroSLF *frame)
1939{
1940 SV *data = (SV *)frame->data;
1941
1942 if (CORO_THROW)
1943 return 0;
1944
1945 if (SvTYPE (SvRV (data)) != SVt_PVAV)
1946 return 1;
1947
1948 /* now push all results on the stack */
1949 {
1950 dSP;
1951 AV *av = (AV *)SvRV (data);
1952 int i;
1953
1954 EXTEND (SP, AvFILLp (av) + 1);
1955 for (i = 0; i <= AvFILLp (av); ++i)
1956 PUSHs (sv_2mortal (AvARRAY (av)[i]));
1957
1958 /* we have stolen the elements, so ste length to zero and free */
1959 AvFILLp (av) = -1;
1960 av_undef (av);
1961
1962 PUTBACK;
1963 }
1964
1965 return 0;
1966}
1967
1968static void
1969slf_init_rouse_wait (pTHX_ struct CoroSLF *frame, CV *cv, SV **arg, int items)
1970{
1971 SV *cb;
1972
1973 if (items)
1974 cb = arg [0];
1975 else
1976 {
1977 struct coro *coro = SvSTATE_current;
1978
1979 if (!coro->rouse_cb)
1980 croak ("Coro::rouse_wait called without rouse callback, and no default rouse callback found either,");
1981
1982 cb = sv_2mortal (coro->rouse_cb);
1983 coro->rouse_cb = 0;
1984 }
1985
1986 if (!SvROK (cb)
1987 || SvTYPE (SvRV (cb)) != SVt_PVCV
1988 || CvXSUB ((CV *)SvRV (cb)) != coro_rouse_callback)
1989 croak ("Coro::rouse_wait called with illegal callback argument,");
1990
1991 {
1992 CV *cv = (CV *)SvRV (cb); /* for GENSUB_ARG */
1993 SV *data = (SV *)GENSUB_ARG;
1994
1995 frame->data = (void *)data;
1996 frame->prepare = SvTYPE (SvRV (data)) == SVt_PVAV ? prepare_nop : prepare_schedule;
1997 frame->check = slf_check_rouse_wait;
1998 }
1999}
2000
2001static SV *
2002coro_new_rouse_cb (pTHX)
2003{
2004 HV *hv = (HV *)SvRV (coro_current);
2005 struct coro *coro = SvSTATE_hv (hv);
2006 SV *data = newRV_inc ((SV *)hv);
2007 SV *cb = gensub (aTHX_ coro_rouse_callback, (void *)data);
2008
2009 sv_magicext (SvRV (cb), data, CORO_MAGIC_type_rouse, 0, 0, 0);
2010 SvREFCNT_dec (data); /* magicext increases the refcount */
2011
2012 SvREFCNT_dec (coro->rouse_cb);
2013 coro->rouse_cb = SvREFCNT_inc_NN (cb);
2014
2015 return cb;
1708} 2016}
1709 2017
1710/*****************************************************************************/ 2018/*****************************************************************************/
1711/* schedule-like-function opcode (SLF) */ 2019/* schedule-like-function opcode (SLF) */
1712 2020
1759static void 2067static void
1760slf_init_schedule (pTHX_ struct CoroSLF *frame, CV *cv, SV **arg, int items) 2068slf_init_schedule (pTHX_ struct CoroSLF *frame, CV *cv, SV **arg, int items)
1761{ 2069{
1762 frame->prepare = prepare_schedule; 2070 frame->prepare = prepare_schedule;
1763 frame->check = slf_check_nop; 2071 frame->check = slf_check_nop;
2072}
2073
2074static void
2075slf_prepare_schedule_to (pTHX_ struct coro_transfer_args *ta)
2076{
2077 struct coro *next = (struct coro *)slf_frame.data;
2078
2079 SvREFCNT_inc_NN (next->hv);
2080 prepare_schedule_to (aTHX_ ta, next);
2081}
2082
2083static void
2084slf_init_schedule_to (pTHX_ struct CoroSLF *frame, CV *cv, SV **arg, int items)
2085{
2086 if (!items)
2087 croak ("Coro::schedule_to expects a coroutine argument, caught");
2088
2089 frame->data = (void *)SvSTATE (arg [0]);
2090 frame->prepare = slf_prepare_schedule_to;
2091 frame->check = slf_check_nop;
2092}
2093
2094static void
2095slf_init_cede_to (pTHX_ struct CoroSLF *frame, CV *cv, SV **arg, int items)
2096{
2097 api_ready (aTHX_ SvRV (coro_current));
2098
2099 slf_init_schedule_to (aTHX_ frame, cv, arg, items);
1764} 2100}
1765 2101
1766static void 2102static void
1767slf_init_cede (pTHX_ struct CoroSLF *frame, CV *cv, SV **arg, int items) 2103slf_init_cede (pTHX_ struct CoroSLF *frame, CV *cv, SV **arg, int items)
1768{ 2104{
2007 SV **ary; 2343 SV **ary;
2008 2344
2009 /* unfortunately, building manually saves memory */ 2345 /* unfortunately, building manually saves memory */
2010 Newx (ary, 2, SV *); 2346 Newx (ary, 2, SV *);
2011 AvALLOC (av) = ary; 2347 AvALLOC (av) = ary;
2012 AvARRAY (av) = ary; 2348 /*AvARRAY (av) = ary;*/
2349 SvPVX ((SV *)av) = (char *)ary; /* 5.8.8 needs this syntax instead of AvARRAY = ary */
2013 AvMAX (av) = 1; 2350 AvMAX (av) = 1;
2014 AvFILLp (av) = 0; 2351 AvFILLp (av) = 0;
2015 ary [0] = newSViv (count); 2352 ary [0] = newSViv (count);
2016 2353
2017 return newRV_noinc ((SV *)av); 2354 return newRV_noinc ((SV *)av);
2037 AvARRAY (av)[0] = AvARRAY (av)[1]; 2374 AvARRAY (av)[0] = AvARRAY (av)[1];
2038 AvARRAY (av)[1] = count_sv; 2375 AvARRAY (av)[1] = count_sv;
2039 cb = av_shift (av); 2376 cb = av_shift (av);
2040 2377
2041 if (SvOBJECT (cb)) 2378 if (SvOBJECT (cb))
2379 {
2042 api_ready (aTHX_ cb); 2380 api_ready (aTHX_ cb);
2043 else 2381 --count;
2044 croak ("callbacks not yet supported"); 2382 }
2383 else if (SvTYPE (cb) == SVt_PVCV)
2384 {
2385 dSP;
2386 PUSHMARK (SP);
2387 XPUSHs (sv_2mortal (newRV_inc ((SV *)av)));
2388 PUTBACK;
2389 call_sv (cb, G_VOID | G_DISCARD | G_EVAL | G_KEEPERR);
2390 }
2045 2391
2046 SvREFCNT_dec (cb); 2392 SvREFCNT_dec (cb);
2047
2048 --count;
2049 } 2393 }
2050} 2394}
2051 2395
2052static void 2396static void
2053coro_semaphore_on_destroy (pTHX_ struct coro *coro) 2397coro_semaphore_on_destroy (pTHX_ struct coro *coro)
2135} 2479}
2136 2480
2137static void 2481static void
2138slf_init_semaphore_wait (pTHX_ struct CoroSLF *frame, CV *cv, SV **arg, int items) 2482slf_init_semaphore_wait (pTHX_ struct CoroSLF *frame, CV *cv, SV **arg, int items)
2139{ 2483{
2484 if (items >= 2)
2485 {
2486 /* callback form */
2487 AV *av = (AV *)SvRV (arg [0]);
2488 CV *cb_cv = coro_sv_2cv (aTHX_ arg [1]);
2489
2490 av_push (av, (SV *)SvREFCNT_inc_NN (cb_cv));
2491
2492 if (SvIVX (AvARRAY (av)[0]) > 0)
2493 coro_semaphore_adjust (aTHX_ av, 0);
2494
2495 frame->prepare = prepare_nop;
2496 frame->check = slf_check_nop;
2497 }
2498 else
2499 {
2140 slf_init_semaphore_down_or_wait (aTHX_ frame, cv, arg, items); 2500 slf_init_semaphore_down_or_wait (aTHX_ frame, cv, arg, items);
2141 frame->check = slf_check_semaphore_wait; 2501 frame->check = slf_check_semaphore_wait;
2502 }
2142} 2503}
2143 2504
2144/* signal */ 2505/* signal */
2145 2506
2146static void 2507static void
2158 AvARRAY (av)[0] = AvARRAY (av)[1]; 2519 AvARRAY (av)[0] = AvARRAY (av)[1];
2159 AvARRAY (av)[1] = cb; 2520 AvARRAY (av)[1] = cb;
2160 2521
2161 cb = av_shift (av); 2522 cb = av_shift (av);
2162 2523
2163 api_ready (cb); 2524 api_ready (aTHX_ cb);
2164 sv_setiv (cb, 0); /* signal waiter */ 2525 sv_setiv (cb, 0); /* signal waiter */
2165 SvREFCNT_dec (cb); 2526 SvREFCNT_dec (cb);
2166 2527
2167 --count; 2528 --count;
2168 } 2529 }
2194 2555
2195 frame->data = (void *)sv_2mortal (SvREFCNT_inc_NN (waiter)); /* owned by process */ 2556 frame->data = (void *)sv_2mortal (SvREFCNT_inc_NN (waiter)); /* owned by process */
2196 frame->prepare = prepare_schedule; 2557 frame->prepare = prepare_schedule;
2197 frame->check = slf_check_signal_wait; 2558 frame->check = slf_check_signal_wait;
2198 } 2559 }
2199}
2200
2201/*****************************************************************************/
2202/* gensub: simple closure generation utility */
2203
2204#define GENSUB_ARG CvXSUBANY (cv).any_ptr
2205
2206/* create a closure from XS, returns a code reference */
2207/* the arg can be accessed via GENSUB_ARG from the callback */
2208/* the callback must use dXSARGS/XSRETURN */
2209static SV *
2210gensub (pTHX_ void (*xsub)(pTHX_ CV *), void *arg)
2211{
2212 CV *cv = (CV *)newSV (0);
2213
2214 sv_upgrade ((SV *)cv, SVt_PVCV);
2215
2216 CvANON_on (cv);
2217 CvISXSUB_on (cv);
2218 CvXSUB (cv) = xsub;
2219 GENSUB_ARG = arg;
2220
2221 return newRV_noinc ((SV *)cv);
2222} 2560}
2223 2561
2224/*****************************************************************************/ 2562/*****************************************************************************/
2225/* Coro::AIO */ 2563/* Coro::AIO */
2226 2564
2241 dXSARGS; 2579 dXSARGS;
2242 AV *state = (AV *)GENSUB_ARG; 2580 AV *state = (AV *)GENSUB_ARG;
2243 SV *coro = av_pop (state); 2581 SV *coro = av_pop (state);
2244 SV *data_sv = newSV (sizeof (struct io_state)); 2582 SV *data_sv = newSV (sizeof (struct io_state));
2245 2583
2246 av_extend (state, items); 2584 av_extend (state, items - 1);
2247 2585
2248 sv_upgrade (data_sv, SVt_PV); 2586 sv_upgrade (data_sv, SVt_PV);
2249 SvCUR_set (data_sv, sizeof (struct io_state)); 2587 SvCUR_set (data_sv, sizeof (struct io_state));
2250 SvPOK_only (data_sv); 2588 SvPOK_only (data_sv);
2251 2589
2461 assert (("PRIO_NORMAL must be 0", !PRIO_NORMAL)); 2799 assert (("PRIO_NORMAL must be 0", !PRIO_NORMAL));
2462} 2800}
2463 2801
2464SV * 2802SV *
2465new (char *klass, ...) 2803new (char *klass, ...)
2804 ALIAS:
2805 Coro::new = 1
2466 CODE: 2806 CODE:
2467{ 2807{
2468 struct coro *coro; 2808 struct coro *coro;
2469 MAGIC *mg; 2809 MAGIC *mg;
2470 HV *hv; 2810 HV *hv;
2811 CV *cb;
2471 int i; 2812 int i;
2813
2814 if (items > 1)
2815 {
2816 cb = coro_sv_2cv (aTHX_ ST (1));
2817
2818 if (!ix)
2819 {
2820 if (CvISXSUB (cb))
2821 croak ("Coro::State doesn't support XS functions as coroutine start, caught");
2822
2823 if (!CvROOT (cb))
2824 croak ("Coro::State doesn't support autoloaded or undefined functions as coroutine start, caught");
2825 }
2826 }
2472 2827
2473 Newz (0, coro, 1, struct coro); 2828 Newz (0, coro, 1, struct coro);
2474 coro->args = newAV (); 2829 coro->args = newAV ();
2475 coro->flags = CF_NEW; 2830 coro->flags = CF_NEW;
2476 2831
2481 coro->hv = hv = newHV (); 2836 coro->hv = hv = newHV ();
2482 mg = sv_magicext ((SV *)hv, 0, CORO_MAGIC_type_state, &coro_state_vtbl, (char *)coro, 0); 2837 mg = sv_magicext ((SV *)hv, 0, CORO_MAGIC_type_state, &coro_state_vtbl, (char *)coro, 0);
2483 mg->mg_flags |= MGf_DUP; 2838 mg->mg_flags |= MGf_DUP;
2484 RETVAL = sv_bless (newRV_noinc ((SV *)hv), gv_stashpv (klass, 1)); 2839 RETVAL = sv_bless (newRV_noinc ((SV *)hv), gv_stashpv (klass, 1));
2485 2840
2841 if (items > 1)
2842 {
2486 av_extend (coro->args, items - 1); 2843 av_extend (coro->args, items - 1 + ix - 1);
2844
2845 if (ix)
2846 {
2847 av_push (coro->args, SvREFCNT_inc_NN ((SV *)cb));
2848 cb = cv_coro_run;
2849 }
2850
2851 coro->startcv = (CV *)SvREFCNT_inc_NN ((SV *)cb);
2852
2487 for (i = 1; i < items; i++) 2853 for (i = 2; i < items; i++)
2488 av_push (coro->args, newSVsv (ST (i))); 2854 av_push (coro->args, newSVsv (ST (i)));
2855 }
2489} 2856}
2490 OUTPUT: 2857 OUTPUT:
2491 RETVAL 2858 RETVAL
2492 2859
2493void 2860void
2691 3058
2692BOOT: 3059BOOT:
2693{ 3060{
2694 int i; 3061 int i;
2695 3062
2696 av_async_pool = coro_get_av (aTHX_ "Coro::async_pool", TRUE);
2697 sv_pool_rss = coro_get_sv (aTHX_ "Coro::POOL_RSS" , TRUE); 3063 sv_pool_rss = coro_get_sv (aTHX_ "Coro::POOL_RSS" , TRUE);
2698 sv_pool_size = coro_get_sv (aTHX_ "Coro::POOL_SIZE" , TRUE); 3064 sv_pool_size = coro_get_sv (aTHX_ "Coro::POOL_SIZE" , TRUE);
2699 3065 cv_coro_run = get_cv ( "Coro::_terminate", GV_ADD);
3066 cv_coro_terminate = get_cv ( "Coro::terminate" , GV_ADD);
2700 coro_current = coro_get_sv (aTHX_ "Coro::current", FALSE); 3067 coro_current = coro_get_sv (aTHX_ "Coro::current" , FALSE); SvREADONLY_on (coro_current);
2701 SvREADONLY_on (coro_current); 3068 av_async_pool = coro_get_av (aTHX_ "Coro::async_pool", TRUE);
3069 av_destroy = coro_get_av (aTHX_ "Coro::destroy" , TRUE);
3070 sv_manager = coro_get_sv (aTHX_ "Coro::manager" , TRUE);
3071
3072 sv_async_pool_idle = newSVpv ("[async pool idle]", 0); SvREADONLY_on (sv_async_pool_idle);
3073 sv_Coro = newSVpv ("Coro", 0); SvREADONLY_on (sv_Coro);
3074 cv_pool_handler = get_cv ("Coro::pool_handler", GV_ADD); SvREADONLY_on (cv_pool_handler);
3075 cv_coro_state_new = get_cv ("Coro::State::new", 0); SvREADONLY_on (cv_coro_state_new);
2702 3076
2703 coro_stash = gv_stashpv ("Coro", TRUE); 3077 coro_stash = gv_stashpv ("Coro", TRUE);
2704 3078
2705 newCONSTSUB (coro_stash, "PRIO_MAX", newSViv (PRIO_MAX)); 3079 newCONSTSUB (coro_stash, "PRIO_MAX", newSViv (PRIO_MAX));
2706 newCONSTSUB (coro_stash, "PRIO_HIGH", newSViv (PRIO_HIGH)); 3080 newCONSTSUB (coro_stash, "PRIO_HIGH", newSViv (PRIO_HIGH));
2714 3088
2715 { 3089 {
2716 SV *sv = coro_get_sv (aTHX_ "Coro::API", TRUE); 3090 SV *sv = coro_get_sv (aTHX_ "Coro::API", TRUE);
2717 3091
2718 coroapi.schedule = api_schedule; 3092 coroapi.schedule = api_schedule;
3093 coroapi.schedule_to = api_schedule_to;
2719 coroapi.cede = api_cede; 3094 coroapi.cede = api_cede;
2720 coroapi.cede_notself = api_cede_notself; 3095 coroapi.cede_notself = api_cede_notself;
2721 coroapi.ready = api_ready; 3096 coroapi.ready = api_ready;
2722 coroapi.is_ready = api_is_ready; 3097 coroapi.is_ready = api_is_ready;
2723 coroapi.nready = coro_nready; 3098 coroapi.nready = coro_nready;
2728 SvREADONLY_on (sv); 3103 SvREADONLY_on (sv);
2729 } 3104 }
2730} 3105}
2731 3106
2732void 3107void
3108terminate (...)
3109 CODE:
3110 CORO_EXECUTE_SLF_XS (slf_init_terminate);
3111
3112void
2733schedule (...) 3113schedule (...)
2734 CODE: 3114 CODE:
2735 CORO_EXECUTE_SLF_XS (slf_init_schedule); 3115 CORO_EXECUTE_SLF_XS (slf_init_schedule);
3116
3117void
3118schedule_to (...)
3119 CODE:
3120 CORO_EXECUTE_SLF_XS (slf_init_schedule_to);
3121
3122void
3123cede_to (...)
3124 CODE:
3125 CORO_EXECUTE_SLF_XS (slf_init_cede_to);
2736 3126
2737void 3127void
2738cede (...) 3128cede (...)
2739 CODE: 3129 CODE:
2740 CORO_EXECUTE_SLF_XS (slf_init_cede); 3130 CORO_EXECUTE_SLF_XS (slf_init_cede);
2741 3131
2742void 3132void
2743cede_notself (...) 3133cede_notself (...)
2744 CODE: 3134 CODE:
2745 CORO_EXECUTE_SLF_XS (slf_init_cede_notself); 3135 CORO_EXECUTE_SLF_XS (slf_init_cede_notself);
3136
3137void
3138_cancel (Coro::State self)
3139 CODE:
3140 coro_state_destroy (aTHX_ self);
3141 coro_call_on_destroy (aTHX_ self);
2746 3142
2747void 3143void
2748_set_current (SV *current) 3144_set_current (SV *current)
2749 PROTOTYPE: $ 3145 PROTOTYPE: $
2750 CODE: 3146 CODE:
2795 CODE: 3191 CODE:
2796 RETVAL = coro_nready; 3192 RETVAL = coro_nready;
2797 OUTPUT: 3193 OUTPUT:
2798 RETVAL 3194 RETVAL
2799 3195
2800# for async_pool speedup
2801void 3196void
2802_pool_1 (SV *cb) 3197_pool_handler (...)
2803 CODE: 3198 CODE:
2804{ 3199 CORO_EXECUTE_SLF_XS (slf_init_pool_handler);
2805 HV *hv = (HV *)SvRV (coro_current);
2806 struct coro *coro = SvSTATE_hv ((SV *)hv);
2807 AV *defav = GvAV (PL_defgv);
2808 SV *invoke = hv_delete (hv, "_invoke", sizeof ("_invoke") - 1, 0);
2809 AV *invoke_av;
2810 int i, len;
2811 3200
2812 if (!invoke) 3201void
3202async_pool (SV *cv, ...)
3203 PROTOTYPE: &@
3204 PPCODE:
3205{
3206 HV *hv = (HV *)av_pop (av_async_pool);
3207 AV *av = newAV ();
3208 SV *cb = ST (0);
3209 int i;
3210
3211 av_extend (av, items - 2);
3212 for (i = 1; i < items; ++i)
3213 av_push (av, SvREFCNT_inc_NN (ST (i)));
3214
3215 if ((SV *)hv == &PL_sv_undef)
2813 { 3216 {
2814 SV *old = PL_diehook; 3217 PUSHMARK (SP);
2815 PL_diehook = 0; 3218 EXTEND (SP, 2);
2816 SvREFCNT_dec (old); 3219 PUSHs (sv_Coro);
2817 croak ("\3async_pool terminate\2\n"); 3220 PUSHs ((SV *)cv_pool_handler);
3221 PUTBACK;
3222 call_sv ((SV *)cv_coro_state_new, G_SCALAR);
3223 SPAGAIN;
3224
3225 hv = (HV *)SvREFCNT_inc_NN (SvRV (POPs));
2818 } 3226 }
2819 3227
2820 SvREFCNT_dec (coro->saved_deffh);
2821 coro->saved_deffh = SvREFCNT_inc_NN ((SV *)PL_defoutgv);
2822
2823 hv_store (hv, "desc", sizeof ("desc") - 1,
2824 newSVpvn ("[async_pool]", sizeof ("[async_pool]") - 1), 0);
2825
2826 invoke_av = (AV *)SvRV (invoke);
2827 len = av_len (invoke_av);
2828
2829 sv_setsv (cb, AvARRAY (invoke_av)[0]);
2830
2831 if (len > 0)
2832 { 3228 {
2833 av_fill (defav, len - 1); 3229 struct coro *coro = SvSTATE_hv (hv);
2834 for (i = 0; i < len; ++i) 3230
2835 av_store (defav, i, SvREFCNT_inc_NN (AvARRAY (invoke_av)[i + 1])); 3231 assert (!coro->invoke_cb);
3232 assert (!coro->invoke_av);
3233 coro->invoke_cb = SvREFCNT_inc (cb);
3234 coro->invoke_av = av;
2836 } 3235 }
3236
3237 api_ready (aTHX_ (SV *)hv);
3238
3239 if (GIMME_V != G_VOID)
3240 XPUSHs (sv_2mortal (newRV_noinc ((SV *)hv)));
3241 else
3242 SvREFCNT_dec (hv);
2837} 3243}
3244
3245SV *
3246rouse_cb ()
3247 PROTOTYPE:
3248 CODE:
3249 RETVAL = coro_new_rouse_cb (aTHX);
3250 OUTPUT:
3251 RETVAL
2838 3252
2839void 3253void
2840_pool_2 (SV *cb) 3254rouse_wait (...)
3255 PROTOTYPE: ;$
2841 CODE: 3256 PPCODE:
2842{ 3257 CORO_EXECUTE_SLF_XS (slf_init_rouse_wait);
2843 HV *hv = (HV *)SvRV (coro_current);
2844 struct coro *coro = SvSTATE_hv ((SV *)hv);
2845
2846 sv_setsv (cb, &PL_sv_undef);
2847
2848 SvREFCNT_dec ((SV *)PL_defoutgv); PL_defoutgv = (GV *)coro->saved_deffh;
2849 coro->saved_deffh = 0;
2850
2851 if (coro_rss (aTHX_ coro) > SvUV (sv_pool_rss)
2852 || av_len (av_async_pool) + 1 >= SvIV (sv_pool_size))
2853 {
2854 SV *old = PL_diehook;
2855 PL_diehook = 0;
2856 SvREFCNT_dec (old);
2857 croak ("\3async_pool terminate\2\n");
2858 }
2859
2860 av_clear (GvAV (PL_defgv));
2861 hv_store (hv, "desc", sizeof ("desc") - 1,
2862 newSVpvn ("[async_pool idle]", sizeof ("[async_pool idle]") - 1), 0);
2863
2864 coro->prio = 0;
2865
2866 if (coro->cctx && (coro->cctx->flags & CC_TRACE))
2867 api_trace (aTHX_ coro_current, 0);
2868
2869 av_push (av_async_pool, newSVsv (coro_current));
2870}
2871 3258
2872 3259
2873MODULE = Coro::State PACKAGE = PerlIO::cede 3260MODULE = Coro::State PACKAGE = PerlIO::cede
2874 3261
2875BOOT: 3262BOOT:
2909 adjust = 1 3296 adjust = 1
2910 CODE: 3297 CODE:
2911 coro_semaphore_adjust (aTHX_ (AV *)SvRV (self), ix ? adjust : 1); 3298 coro_semaphore_adjust (aTHX_ (AV *)SvRV (self), ix ? adjust : 1);
2912 3299
2913void 3300void
2914down (SV *self) 3301down (...)
2915 CODE: 3302 CODE:
2916 CORO_EXECUTE_SLF_XS (slf_init_semaphore_down); 3303 CORO_EXECUTE_SLF_XS (slf_init_semaphore_down);
2917 3304
2918void 3305void
2919wait (SV *self) 3306wait (...)
2920 CODE: 3307 CODE:
2921 CORO_EXECUTE_SLF_XS (slf_init_semaphore_wait); 3308 CORO_EXECUTE_SLF_XS (slf_init_semaphore_wait);
2922 3309
2923void 3310void
2924try (SV *self) 3311try (SV *self)
2967 ); 3354 );
2968 OUTPUT: 3355 OUTPUT:
2969 RETVAL 3356 RETVAL
2970 3357
2971void 3358void
2972wait (SV *self) 3359wait (...)
2973 CODE: 3360 CODE:
2974 CORO_EXECUTE_SLF_XS (slf_init_signal_wait); 3361 CORO_EXECUTE_SLF_XS (slf_init_signal_wait);
2975 3362
2976void 3363void
2977broadcast (SV *self) 3364broadcast (SV *self)
2986 CODE: 3373 CODE:
2987{ 3374{
2988 AV *av = (AV *)SvRV (self); 3375 AV *av = (AV *)SvRV (self);
2989 3376
2990 if (AvFILLp (av)) 3377 if (AvFILLp (av))
2991 coro_signal_wake (av, 1); 3378 coro_signal_wake (aTHX_ av, 1);
2992 else 3379 else
2993 SvIVX (AvARRAY (av)[0]) = 1; /* remember the signal */ 3380 SvIVX (AvARRAY (av)[0]) = 1; /* remember the signal */
2994} 3381}
2995 3382
2996IV 3383IV
3034 3421
3035void 3422void
3036_register (char *target, char *proto, SV *req) 3423_register (char *target, char *proto, SV *req)
3037 CODE: 3424 CODE:
3038{ 3425{
3039 HV *st; 3426 CV *req_cv = coro_sv_2cv (aTHX_ req);
3040 GV *gvp;
3041 CV *req_cv = sv_2cv (req, &st, &gvp, 0);
3042 /* newXSproto doesn't return the CV on 5.8 */ 3427 /* newXSproto doesn't return the CV on 5.8 */
3043 CV *slf_cv = newXS (target, coro_aio_req_xs, __FILE__); 3428 CV *slf_cv = newXS (target, coro_aio_req_xs, __FILE__);
3044 sv_setpv ((SV *)slf_cv, proto); 3429 sv_setpv ((SV *)slf_cv, proto);
3045 sv_magicext ((SV *)slf_cv, (SV *)req_cv, CORO_MAGIC_type_aio, 0, 0, 0); 3430 sv_magicext ((SV *)slf_cv, (SV *)req_cv, CORO_MAGIC_type_aio, 0, 0, 0);
3046} 3431}

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines