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.289 by root, Mon Nov 17 08:25:06 2008 UTC vs.
Revision 1.302 by root, Wed Nov 19 04:48:24 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
120#endif 120#endif
121 121
122/* The next macros try to return the current stack pointer, in an as 122/* The next macros try to return the current stack pointer, in an as
123 * portable way as possible. */ 123 * portable way as possible. */
124#if __GNUC__ >= 4 124#if __GNUC__ >= 4
125# define dSTACKLEVEL int stacklevel_dummy
125# define dSTACKLEVEL void *stacklevel = __builtin_frame_address (0) 126# define STACKLEVEL __builtin_frame_address (0)
126#else 127#else
127# define dSTACKLEVEL volatile void *stacklevel = (volatile void *)&stacklevel 128# define dSTACKLEVEL volatile void *stacklevel
129# define STACKLEVEL ((void *)&stacklevel)
128#endif 130#endif
129 131
130#define IN_DESTRUCT (PL_main_cv == Nullcv) 132#define IN_DESTRUCT (PL_main_cv == Nullcv)
131 133
132#if __GNUC__ >= 3 134#if __GNUC__ >= 3
143#define expect_true(expr) expect ((expr) != 0, 1) 145#define expect_true(expr) expect ((expr) != 0, 1)
144 146
145#define NOINLINE attribute ((noinline)) 147#define NOINLINE attribute ((noinline))
146 148
147#include "CoroAPI.h" 149#include "CoroAPI.h"
150#define GCoroAPI (&coroapi) /* very sneaky */
148 151
149#ifdef USE_ITHREADS 152#ifdef USE_ITHREADS
150# if CORO_PTHREAD 153# if CORO_PTHREAD
151static void *coro_thx; 154static void *coro_thx;
152# endif 155# endif
153#endif 156#endif
154 157
155static double (*nvtime)(); /* so why doesn't it take void? */ 158static double (*nvtime)(); /* so why doesn't it take void? */
159
160/* we hijack an hopefully unused CV flag for our purposes */
161#define CVf_SLF 0x4000
162static OP *pp_slf (pTHX);
156 163
157static U32 cctx_gen; 164static U32 cctx_gen;
158static size_t cctx_stacksize = CORO_STACKSIZE; 165static size_t cctx_stacksize = CORO_STACKSIZE;
159static struct CoroAPI coroapi; 166static struct CoroAPI coroapi;
160static AV *main_mainstack; /* used to differentiate between $main and others */ 167static AV *main_mainstack; /* used to differentiate between $main and others */
250 /* statistics */ 257 /* statistics */
251 int usecount; /* number of transfers to this coro */ 258 int usecount; /* number of transfers to this coro */
252 259
253 /* coro process data */ 260 /* coro process data */
254 int prio; 261 int prio;
255 SV *throw; /* exception to be thrown */ 262 SV *except; /* exception to be thrown */
263 SV *rouse_cb;
256 264
257 /* async_pool */ 265 /* async_pool */
258 SV *saved_deffh; 266 SV *saved_deffh;
259 267
260 /* linked list */ 268 /* linked list */
266 274
267/* the following variables are effectively part of the perl context */ 275/* the following variables are effectively part of the perl context */
268/* and get copied between struct coro and these variables */ 276/* and get copied between struct coro and these variables */
269/* the mainr easonw e don't support windows process emulation */ 277/* the mainr easonw e don't support windows process emulation */
270static struct CoroSLF slf_frame; /* the current slf frame */ 278static struct CoroSLF slf_frame; /* the current slf frame */
271static SV *coro_throw;
272 279
273/** Coro ********************************************************************/ 280/** Coro ********************************************************************/
274 281
275#define PRIO_MAX 3 282#define PRIO_MAX 3
276#define PRIO_HIGH 1 283#define PRIO_HIGH 1
505 512
506 PUTBACK; 513 PUTBACK;
507 } 514 }
508 515
509 slf_frame = c->slf_frame; 516 slf_frame = c->slf_frame;
510 coro_throw = c->throw; 517 CORO_THROW = c->except;
511} 518}
512 519
513static void 520static void
514save_perl (pTHX_ Coro__State c) 521save_perl (pTHX_ Coro__State c)
515{ 522{
516 c->throw = coro_throw; 523 c->except = CORO_THROW;
517 c->slf_frame = slf_frame; 524 c->slf_frame = slf_frame;
518 525
519 { 526 {
520 dSP; 527 dSP;
521 I32 cxix = cxstack_ix; 528 I32 cxix = cxstack_ix;
814slf_check_nop (pTHX_ struct CoroSLF *frame) 821slf_check_nop (pTHX_ struct CoroSLF *frame)
815{ 822{
816 return 0; 823 return 0;
817} 824}
818 825
826static UNOP coro_setup_op;
827
819static void NOINLINE /* noinline to keep it out of the transfer fast path */ 828static void NOINLINE /* noinline to keep it out of the transfer fast path */
820coro_setup (pTHX_ struct coro *coro) 829coro_setup (pTHX_ struct coro *coro)
821{ 830{
822 /* 831 /*
823 * emulate part of the perl startup here. 832 * emulate part of the perl startup here.
851 { 860 {
852 dSP; 861 dSP;
853 UNOP myop; 862 UNOP myop;
854 863
855 Zero (&myop, 1, UNOP); 864 Zero (&myop, 1, UNOP);
856 myop.op_next = Nullop; 865 myop.op_next = Nullop;
857 myop.op_flags = OPf_WANT_VOID; 866 myop.op_flags = OPf_WANT_VOID;
858 867
859 PUSHMARK (SP); 868 PUSHMARK (SP);
860 XPUSHs (sv_2mortal (av_shift (GvAV (PL_defgv)))); 869 XPUSHs (sv_2mortal (av_shift (GvAV (PL_defgv))));
861 PUTBACK; 870 PUTBACK;
868 * likely was suspended in pp_slf, so we have to emulate entering pp_slf here. 877 * likely was suspended in pp_slf, so we have to emulate entering pp_slf here.
869 */ 878 */
870 slf_frame.prepare = prepare_nop; /* provide a nop function for an eventual pp_slf */ 879 slf_frame.prepare = prepare_nop; /* provide a nop function for an eventual pp_slf */
871 slf_frame.check = slf_check_nop; /* signal pp_slf to not repeat */ 880 slf_frame.check = slf_check_nop; /* signal pp_slf to not repeat */
872 881
873 coro_throw = coro->throw; 882 /* and we have to provide the pp_slf op in any case, so pp_slf can skip it */
883 coro_setup_op.op_next = PL_op;
884 coro_setup_op.op_type = OP_CUSTOM;
885 coro_setup_op.op_ppaddr = pp_slf;
886 /* no flags required, as an init function won't be called */
887
888 PL_op = (OP *)&coro_setup_op;
889
890 /* copy throw, in case it was set before coro_setup */
891 CORO_THROW = coro->except;
874} 892}
875 893
876static void 894static void
877coro_destruct (pTHX_ struct coro *coro) 895coro_destruct (pTHX_ struct coro *coro)
878{ 896{
901 SvREFCNT_dec (GvSV (irsgv)); 919 SvREFCNT_dec (GvSV (irsgv));
902 920
903 SvREFCNT_dec (PL_diehook); 921 SvREFCNT_dec (PL_diehook);
904 SvREFCNT_dec (PL_warnhook); 922 SvREFCNT_dec (PL_warnhook);
905 923
924 SvREFCNT_dec (CORO_THROW);
906 SvREFCNT_dec (coro->saved_deffh); 925 SvREFCNT_dec (coro->saved_deffh);
907 SvREFCNT_dec (coro_throw); 926 SvREFCNT_dec (coro->rouse_cb);
908 927
909 coro_destruct_stacks (aTHX); 928 coro_destruct_stacks (aTHX);
910} 929}
911 930
912INLINE void 931INLINE void
1041 1060
1042 TAINT_NOT; 1061 TAINT_NOT;
1043 return 0; 1062 return 0;
1044} 1063}
1045 1064
1065static struct coro_cctx *cctx_ssl_cctx;
1066static struct CoroSLF cctx_ssl_frame;
1067
1046static void 1068static void
1047prepare_set_stacklevel (struct coro_transfer_args *ta, struct coro_cctx *cctx) 1069slf_prepare_set_stacklevel (pTHX_ struct coro_transfer_args *ta)
1048{ 1070{
1049 ta->prev = (struct coro *)cctx; 1071 ta->prev = (struct coro *)cctx_ssl_cctx;
1050 ta->next = 0; 1072 ta->next = 0;
1051} 1073}
1052 1074
1053/* inject a fake call to Coro::State::_cctx_init into the execution */ 1075static int
1054/* _cctx_init should be careful, as it could be called at almost any time */ 1076slf_check_set_stacklevel (pTHX_ struct CoroSLF *frame)
1055/* during execution of a perl program */ 1077{
1056/* also initialises PL_top_env */ 1078 *frame = cctx_ssl_frame;
1079
1080 return frame->check (aTHX_ frame); /* execute the restored frame - there must be one */
1081}
1082
1083/* initialises PL_top_env and injects a pseudo-slf-call to set the stacklevel */
1057static void NOINLINE 1084static void NOINLINE
1058cctx_prepare (pTHX_ coro_cctx *cctx) 1085cctx_prepare (pTHX_ coro_cctx *cctx)
1059{ 1086{
1060 dSP;
1061 UNOP myop;
1062
1063 PL_top_env = &PL_start_env; 1087 PL_top_env = &PL_start_env;
1064 1088
1065 if (cctx->flags & CC_TRACE) 1089 if (cctx->flags & CC_TRACE)
1066 PL_runops = runops_trace; 1090 PL_runops = runops_trace;
1067 1091
1068 Zero (&myop, 1, UNOP); 1092 /* we already must be executing an SLF op, there is no other valid way
1069 myop.op_next = PL_op; 1093 * that can lead to creation of a new cctx */
1070 myop.op_flags = OPf_WANT_VOID | OPf_STACKED; 1094 assert (("FATAL: can't prepare slf-less cctx in Coro module (please report)",
1095 slf_frame.prepare && PL_op->op_ppaddr == pp_slf));
1071 1096
1072 PUSHMARK (SP); 1097 /* we must emulate leaving pp_slf, which is done inside slf_check_set_stacklevel */
1073 EXTEND (SP, 2); 1098 cctx_ssl_cctx = cctx;
1074 PUSHs (sv_2mortal (newSViv ((IV)cctx))); 1099 cctx_ssl_frame = slf_frame;
1075 PUSHs ((SV *)get_cv ("Coro::State::_cctx_init", FALSE)); 1100
1076 PUTBACK; 1101 slf_frame.prepare = slf_prepare_set_stacklevel;
1077 PL_op = (OP *)&myop; 1102 slf_frame.check = slf_check_set_stacklevel;
1078 PL_op = PL_ppaddr[OP_ENTERSUB](aTHX);
1079 SPAGAIN;
1080} 1103}
1081 1104
1082/* the tail of transfer: execute stuff we can only do after a transfer */ 1105/* the tail of transfer: execute stuff we can only do after a transfer */
1083INLINE void 1106INLINE void
1084transfer_tail (pTHX) 1107transfer_tail (pTHX)
1300 dSTACKLEVEL; 1323 dSTACKLEVEL;
1301 1324
1302 /* sometimes transfer is only called to set idle_sp */ 1325 /* sometimes transfer is only called to set idle_sp */
1303 if (expect_false (!next)) 1326 if (expect_false (!next))
1304 { 1327 {
1305 ((coro_cctx *)prev)->idle_sp = (void *)stacklevel; 1328 ((coro_cctx *)prev)->idle_sp = STACKLEVEL;
1306 assert (((coro_cctx *)prev)->idle_te = PL_top_env); /* just for the side-effect when asserts are enabled */ 1329 assert (((coro_cctx *)prev)->idle_te = PL_top_env); /* just for the side-effect when asserts are enabled */
1307 } 1330 }
1308 else if (expect_true (prev != next)) 1331 else if (expect_true (prev != next))
1309 { 1332 {
1310 coro_cctx *prev__cctx; 1333 coro_cctx *prev__cctx;
1335 1358
1336 prev__cctx = prev->cctx; 1359 prev__cctx = prev->cctx;
1337 1360
1338 /* possibly untie and reuse the cctx */ 1361 /* possibly untie and reuse the cctx */
1339 if (expect_true ( 1362 if (expect_true (
1340 prev__cctx->idle_sp == (void *)stacklevel 1363 prev__cctx->idle_sp == STACKLEVEL
1341 && !(prev__cctx->flags & CC_TRACE) 1364 && !(prev__cctx->flags & CC_TRACE)
1342 && !force_cctx 1365 && !force_cctx
1343 )) 1366 ))
1344 { 1367 {
1345 /* I assume that stacklevel is a stronger indicator than PL_top_env changes */ 1368 /* I assume that stacklevel is a stronger indicator than PL_top_env changes */
1476 1499
1477 prepare_transfer (aTHX_ &ta, prev_sv, next_sv); 1500 prepare_transfer (aTHX_ &ta, prev_sv, next_sv);
1478 TRANSFER (ta, 1); 1501 TRANSFER (ta, 1);
1479} 1502}
1480 1503
1504/*****************************************************************************/
1505/* gensub: simple closure generation utility */
1506
1507#define GENSUB_ARG CvXSUBANY (cv).any_ptr
1508
1509/* create a closure from XS, returns a code reference */
1510/* the arg can be accessed via GENSUB_ARG from the callback */
1511/* the callback must use dXSARGS/XSRETURN */
1512static SV *
1513gensub (pTHX_ void (*xsub)(pTHX_ CV *), void *arg)
1514{
1515 CV *cv = (CV *)newSV (0);
1516
1517 sv_upgrade ((SV *)cv, SVt_PVCV);
1518
1519 CvANON_on (cv);
1520 CvISXSUB_on (cv);
1521 CvXSUB (cv) = xsub;
1522 GENSUB_ARG = arg;
1523
1524 return newRV_noinc ((SV *)cv);
1525}
1526
1481/** Coro ********************************************************************/ 1527/** Coro ********************************************************************/
1482 1528
1483INLINE void 1529INLINE void
1484coro_enq (pTHX_ struct coro *coro) 1530coro_enq (pTHX_ struct coro *coro)
1485{ 1531{
1528 ENTER; 1574 ENTER;
1529 SAVETMPS; 1575 SAVETMPS;
1530 1576
1531 PUSHMARK (SP); 1577 PUSHMARK (SP);
1532 PUTBACK; 1578 PUTBACK;
1533 call_sv (sv_hook, G_DISCARD); 1579 call_sv (sv_hook, G_VOID | G_DISCARD);
1534 SPAGAIN;
1535 1580
1536 FREETMPS; 1581 FREETMPS;
1537 LEAVE; 1582 LEAVE;
1538 } 1583 }
1539 1584
1566 ENTER; 1611 ENTER;
1567 SAVETMPS; 1612 SAVETMPS;
1568 1613
1569 PUSHMARK (SP); 1614 PUSHMARK (SP);
1570 PUTBACK; 1615 PUTBACK;
1571 call_sv (get_sv ("Coro::idle", FALSE), G_DISCARD); 1616 call_sv (get_sv ("Coro::idle", FALSE), G_VOID | G_DISCARD);
1572 SPAGAIN;
1573 1617
1574 FREETMPS; 1618 FREETMPS;
1575 LEAVE; 1619 LEAVE;
1576 continue; 1620 continue;
1577 } 1621 }
1687 coro->slot->runops = RUNOPS_DEFAULT; 1731 coro->slot->runops = RUNOPS_DEFAULT;
1688 } 1732 }
1689} 1733}
1690 1734
1691/*****************************************************************************/ 1735/*****************************************************************************/
1736/* rouse callback */
1737
1738#define CORO_MAGIC_type_rouse PERL_MAGIC_ext
1739
1740static void
1741coro_rouse_callback (pTHX_ CV *cv)
1742{
1743 dXSARGS;
1744 SV *data = (SV *)GENSUB_ARG;
1745
1746 if (SvTYPE (SvRV (data)) != SVt_PVAV)
1747 {
1748 /* first call, set args */
1749 int i;
1750 AV *av = newAV ();
1751 SV *coro = SvRV (data);
1752
1753 SvRV_set (data, (SV *)av);
1754 api_ready (aTHX_ coro);
1755 SvREFCNT_dec (coro);
1756
1757 while (items--)
1758 av_store (av, items, SvREFCNT_inc_NN (ST (items)));
1759 }
1760
1761 XSRETURN_EMPTY;
1762}
1763
1764static int
1765slf_check_rouse_wait (pTHX_ struct CoroSLF *frame)
1766{
1767 SV *data = (SV *)frame->data;
1768
1769 if (CORO_THROW)
1770 return 0;
1771
1772 if (SvTYPE (SvRV (data)) != SVt_PVAV)
1773 return 1;
1774
1775 /* now push all results on the stack */
1776 {
1777 dSP;
1778 AV *av = (AV *)SvRV (data);
1779 int i;
1780
1781 EXTEND (SP, AvFILLp (av) + 1);
1782 for (i = 0; i <= AvFILLp (av); ++i)
1783 PUSHs (AvARRAY (av)[i]);
1784
1785 PUTBACK;
1786 }
1787
1788 return 0;
1789}
1790
1791static void
1792slf_init_rouse_wait (pTHX_ struct CoroSLF *frame, CV *cv, SV **arg, int items)
1793{
1794 SV *cb;
1795
1796 if (items)
1797 cb = arg [0];
1798 else
1799 {
1800 struct coro *coro = SvSTATE_current;
1801
1802 if (!coro->rouse_cb)
1803 croak ("Coro::rouse_wait called without rouse callback, and no default rouse callback found either,");
1804
1805 cb = sv_2mortal (coro->rouse_cb);
1806 coro->rouse_cb = 0;
1807 }
1808
1809 if (!SvROK (cb)
1810 || SvTYPE (SvRV (cb)) != SVt_PVCV
1811 || CvXSUB ((CV *)SvRV (cb)) != coro_rouse_callback)
1812 croak ("Coro::rouse_wait called with illegal callback argument,");
1813
1814 {
1815 CV *cv = (CV *)SvRV (cb); /* for GENSUB_ARG */
1816 SV *data = (SV *)GENSUB_ARG;
1817
1818 frame->data = (void *)data;
1819 frame->prepare = SvTYPE (SvRV (data)) == SVt_PVAV ? prepare_nop : prepare_schedule;
1820 frame->check = slf_check_rouse_wait;
1821 }
1822}
1823
1824static SV *
1825coro_new_rouse_cb (pTHX)
1826{
1827 HV *hv = (HV *)SvRV (coro_current);
1828 struct coro *coro = SvSTATE_hv (hv);
1829 SV *data = newRV_inc ((SV *)hv);
1830 SV *cb = gensub (aTHX_ coro_rouse_callback, (void *)data);
1831
1832 sv_magicext (SvRV (cb), data, CORO_MAGIC_type_rouse, 0, 0, 0);
1833
1834 SvREFCNT_dec (coro->rouse_cb);
1835 coro->rouse_cb = SvREFCNT_inc_NN (cb);
1836
1837 return cb;
1838}
1839
1840/*****************************************************************************/
1692/* schedule-like-function opcode (SLF) */ 1841/* schedule-like-function opcode (SLF) */
1693 1842
1694static UNOP slf_restore; /* restore stack as entersub did, for first-re-run */ 1843static UNOP slf_restore; /* restore stack as entersub did, for first-re-run */
1695static const CV *slf_cv; 1844static const CV *slf_cv;
1696static SV **slf_argv; 1845static SV **slf_argv;
1717 1866
1718 RETURNOP (slf_restore.op_first); 1867 RETURNOP (slf_restore.op_first);
1719} 1868}
1720 1869
1721static void 1870static void
1722slf_prepare_set_stacklevel (pTHX_ struct coro_transfer_args *ta)
1723{
1724 prepare_set_stacklevel (ta, (struct coro_cctx *)slf_frame.data);
1725}
1726
1727static void
1728slf_init_set_stacklevel (pTHX_ struct CoroSLF *frame, CV *cv, SV **arg, int items)
1729{
1730 assert (("FATAL: set_stacklevel needs the coro cctx as sole argument", items == 1));
1731
1732 frame->prepare = slf_prepare_set_stacklevel;
1733 frame->check = slf_check_nop;
1734 frame->data = (void *)SvIV (arg [0]);
1735}
1736
1737static void
1738slf_prepare_transfer (pTHX_ struct coro_transfer_args *ta) 1871slf_prepare_transfer (pTHX_ struct coro_transfer_args *ta)
1739{ 1872{
1740 SV **arg = (SV **)slf_frame.data; 1873 SV **arg = (SV **)slf_frame.data;
1741 1874
1742 prepare_transfer (aTHX_ ta, arg [0], arg [1]); 1875 prepare_transfer (aTHX_ ta, arg [0], arg [1]);
1771slf_init_cede_notself (pTHX_ struct CoroSLF *frame, CV *cv, SV **arg, int items) 1904slf_init_cede_notself (pTHX_ struct CoroSLF *frame, CV *cv, SV **arg, int items)
1772{ 1905{
1773 frame->prepare = prepare_cede_notself; 1906 frame->prepare = prepare_cede_notself;
1774 frame->check = slf_check_nop; 1907 frame->check = slf_check_nop;
1775} 1908}
1776
1777/* we hijack an hopefully unused CV flag for our purposes */
1778#define CVf_SLF 0x4000
1779 1909
1780/* 1910/*
1781 * these not obviously related functions are all rolled into one 1911 * these not obviously related functions are all rolled into one
1782 * function to increase chances that they all will call transfer with the same 1912 * function to increase chances that they all will call transfer with the same
1783 * stack offset 1913 * stack offset
1839 } 1969 }
1840 while (slf_frame.check (aTHX_ &slf_frame)); 1970 while (slf_frame.check (aTHX_ &slf_frame));
1841 1971
1842 slf_frame.prepare = 0; /* invalidate the frame, we are done processing it */ 1972 slf_frame.prepare = 0; /* invalidate the frame, we are done processing it */
1843 1973
1844 /* return value handling - mostly like entersub */
1845 {
1846 dSP;
1847 SV **bot = PL_stack_base + checkmark;
1848 int gimme = GIMME_V;
1849
1850 /* make sure we put something on the stack in scalar context */
1851 if (gimme == G_SCALAR)
1852 {
1853 if (sp == bot)
1854 XPUSHs (&PL_sv_undef);
1855
1856 SP = bot + 1;
1857 }
1858
1859 PUTBACK;
1860 }
1861
1862 /* exception handling */ 1974 /* exception handling */
1863 if (expect_false (coro_throw)) 1975 if (expect_false (CORO_THROW))
1864 { 1976 {
1865 SV *exception = sv_2mortal (coro_throw); 1977 SV *exception = sv_2mortal (CORO_THROW);
1866 1978
1867 coro_throw = 0; 1979 CORO_THROW = 0;
1868 sv_setsv (ERRSV, exception); 1980 sv_setsv (ERRSV, exception);
1869 croak (0); 1981 croak (0);
1982 }
1983
1984 /* return value handling - mostly like entersub */
1985 /* make sure we put something on the stack in scalar context */
1986 if (GIMME_V == G_SCALAR)
1987 {
1988 dSP;
1989 SV **bot = PL_stack_base + checkmark;
1990
1991 if (sp == bot) /* too few, push undef */
1992 bot [1] = &PL_sv_undef;
1993 else if (sp != bot + 1) /* too many, take last one */
1994 bot [1] = *sp;
1995
1996 SP = bot + 1;
1997
1998 PUTBACK;
1870 } 1999 }
1871 2000
1872 return NORMAL; 2001 return NORMAL;
1873} 2002}
1874 2003
1996 PerlIOBuf_get_cnt, 2125 PerlIOBuf_get_cnt,
1997 PerlIOBuf_set_ptrcnt, 2126 PerlIOBuf_set_ptrcnt,
1998}; 2127};
1999 2128
2000/*****************************************************************************/ 2129/*****************************************************************************/
2130/* Coro::Semaphore & Coro::Signal */
2131
2132static SV *
2133coro_waitarray_new (pTHX_ int count)
2134{
2135 /* a semaphore contains a counter IV in $sem->[0] and any waiters after that */
2136 AV *av = newAV ();
2137 SV **ary;
2138
2139 /* unfortunately, building manually saves memory */
2140 Newx (ary, 2, SV *);
2141 AvALLOC (av) = ary;
2142 AvARRAY (av) = ary;
2143 AvMAX (av) = 1;
2144 AvFILLp (av) = 0;
2145 ary [0] = newSViv (count);
2146
2147 return newRV_noinc ((SV *)av);
2148}
2149
2001/* Coro::Semaphore */ 2150/* semaphore */
2002 2151
2003static void 2152static void
2004coro_semaphore_adjust (pTHX_ AV *av, IV adjust) 2153coro_semaphore_adjust (pTHX_ AV *av, IV adjust)
2005{ 2154{
2006 SV *count_sv = AvARRAY (av)[0]; 2155 SV *count_sv = AvARRAY (av)[0];
2036 /* call $sem->adjust (0) to possibly wake up some other waiters */ 2185 /* call $sem->adjust (0) to possibly wake up some other waiters */
2037 coro_semaphore_adjust (aTHX_ (AV *)coro->slf_frame.data, 0); 2186 coro_semaphore_adjust (aTHX_ (AV *)coro->slf_frame.data, 0);
2038} 2187}
2039 2188
2040static int 2189static int
2041slf_check_semaphore_down (pTHX_ struct CoroSLF *frame) 2190slf_check_semaphore_down_or_wait (pTHX_ struct CoroSLF *frame, int acquire)
2042{ 2191{
2043 AV *av = (AV *)frame->data; 2192 AV *av = (AV *)frame->data;
2044 SV *count_sv = AvARRAY (av)[0]; 2193 SV *count_sv = AvARRAY (av)[0];
2045 2194
2195 /* if we are about to throw, don't actually acquire the lock, just throw */
2196 if (CORO_THROW)
2197 return 0;
2046 if (SvIVX (count_sv) > 0) 2198 else if (SvIVX (count_sv) > 0)
2047 { 2199 {
2048 SvSTATE_current->on_destroy = 0; 2200 SvSTATE_current->on_destroy = 0;
2201
2202 if (acquire)
2049 SvIVX (count_sv) = SvIVX (count_sv) - 1; 2203 SvIVX (count_sv) = SvIVX (count_sv) - 1;
2204 else
2205 coro_semaphore_adjust (aTHX_ av, 0);
2206
2050 return 0; 2207 return 0;
2051 } 2208 }
2052 else 2209 else
2053 { 2210 {
2054 int i; 2211 int i;
2063 av_push (av, SvREFCNT_inc (SvRV (coro_current))); 2220 av_push (av, SvREFCNT_inc (SvRV (coro_current)));
2064 return 1; 2221 return 1;
2065 } 2222 }
2066} 2223}
2067 2224
2068static void 2225static int
2226slf_check_semaphore_down (pTHX_ struct CoroSLF *frame)
2227{
2228 return slf_check_semaphore_down_or_wait (aTHX_ frame, 1);
2229}
2230
2231static int
2232slf_check_semaphore_wait (pTHX_ struct CoroSLF *frame)
2233{
2234 return slf_check_semaphore_down_or_wait (aTHX_ frame, 0);
2235}
2236
2237static void
2069slf_init_semaphore_down (pTHX_ struct CoroSLF *frame, CV *cv, SV **arg, int items) 2238slf_init_semaphore_down_or_wait (pTHX_ struct CoroSLF *frame, CV *cv, SV **arg, int items)
2070{ 2239{
2071 AV *av = (AV *)SvRV (arg [0]); 2240 AV *av = (AV *)SvRV (arg [0]);
2072 2241
2073 if (SvIVX (AvARRAY (av)[0]) > 0) 2242 if (SvIVX (AvARRAY (av)[0]) > 0)
2074 { 2243 {
2075 frame->data = (void *)av; 2244 frame->data = (void *)av;
2076 frame->prepare = prepare_nop; 2245 frame->prepare = prepare_nop;
2077 SvSTATE_current->on_destroy = coro_semaphore_on_destroy;
2078 } 2246 }
2079 else 2247 else
2080 { 2248 {
2081 av_push (av, SvREFCNT_inc (SvRV (coro_current))); 2249 av_push (av, SvREFCNT_inc (SvRV (coro_current)));
2082 2250
2083 frame->data = (void *)sv_2mortal (SvREFCNT_inc ((SV *)av)); 2251 frame->data = (void *)sv_2mortal (SvREFCNT_inc ((SV *)av));
2084 frame->prepare = prepare_schedule; 2252 frame->prepare = prepare_schedule;
2085 2253
2086 /* to avoid race conditions when a woken-up coro gets terminated */ 2254 /* to avoid race conditions when a woken-up coro gets terminated */
2087 /* we arrange for a temporary on_destroy that calls adjust (0) */ 2255 /* we arrange for a temporary on_destroy that calls adjust (0) */
2088 assert (!SvSTATE_current->on_destroy);//D
2089 SvSTATE_current->on_destroy = coro_semaphore_on_destroy; 2256 SvSTATE_current->on_destroy = coro_semaphore_on_destroy;
2090 } 2257 }
2258}
2091 2259
2260static void
2261slf_init_semaphore_down (pTHX_ struct CoroSLF *frame, CV *cv, SV **arg, int items)
2262{
2263 slf_init_semaphore_down_or_wait (aTHX_ frame, cv, arg, items);
2092 frame->check = slf_check_semaphore_down; 2264 frame->check = slf_check_semaphore_down;
2093
2094} 2265}
2095 2266
2096/*****************************************************************************/ 2267static void
2097/* gensub: simple closure generation utility */ 2268slf_init_semaphore_wait (pTHX_ struct CoroSLF *frame, CV *cv, SV **arg, int items)
2098
2099#define GENSUB_ARG CvXSUBANY (cv).any_ptr
2100
2101/* create a closure from XS, returns a code reference */
2102/* the arg can be accessed via GENSUB_ARG from the callback */
2103/* the callback must use dXSARGS/XSRETURN */
2104static SV *
2105gensub (pTHX_ void (*xsub)(pTHX_ CV *), void *arg)
2106{ 2269{
2107 CV *cv = (CV *)newSV (0); 2270 slf_init_semaphore_down_or_wait (aTHX_ frame, cv, arg, items);
2271 frame->check = slf_check_semaphore_wait;
2272}
2108 2273
2109 sv_upgrade ((SV *)cv, SVt_PVCV); 2274/* signal */
2110 2275
2111 CvANON_on (cv); 2276static void
2112 CvISXSUB_on (cv); 2277coro_signal_wake (pTHX_ AV *av, int count)
2113 CvXSUB (cv) = xsub; 2278{
2114 GENSUB_ARG = arg; 2279 SvIVX (AvARRAY (av)[0]) = 0;
2115 2280
2116 return newRV_noinc ((SV *)cv); 2281 /* now signal count waiters */
2282 while (count > 0 && AvFILLp (av) > 0)
2283 {
2284 SV *cb;
2285
2286 /* swap first two elements so we can shift a waiter */
2287 cb = AvARRAY (av)[0];
2288 AvARRAY (av)[0] = AvARRAY (av)[1];
2289 AvARRAY (av)[1] = cb;
2290
2291 cb = av_shift (av);
2292
2293 api_ready (aTHX_ cb);
2294 sv_setiv (cb, 0); /* signal waiter */
2295 SvREFCNT_dec (cb);
2296
2297 --count;
2298 }
2299}
2300
2301static int
2302slf_check_signal_wait (pTHX_ struct CoroSLF *frame)
2303{
2304 /* if we are about to throw, also stop waiting */
2305 return SvROK ((SV *)frame->data) && !CORO_THROW;
2306}
2307
2308static void
2309slf_init_signal_wait (pTHX_ struct CoroSLF *frame, CV *cv, SV **arg, int items)
2310{
2311 AV *av = (AV *)SvRV (arg [0]);
2312
2313 if (SvIVX (AvARRAY (av)[0]))
2314 {
2315 SvIVX (AvARRAY (av)[0]) = 0;
2316 frame->prepare = prepare_nop;
2317 frame->check = slf_check_nop;
2318 }
2319 else
2320 {
2321 SV *waiter = newRV_inc (SvRV (coro_current)); /* owned by signal av */
2322
2323 av_push (av, waiter);
2324
2325 frame->data = (void *)sv_2mortal (SvREFCNT_inc_NN (waiter)); /* owned by process */
2326 frame->prepare = prepare_schedule;
2327 frame->check = slf_check_signal_wait;
2328 }
2117} 2329}
2118 2330
2119/*****************************************************************************/ 2331/*****************************************************************************/
2120/* Coro::AIO */ 2332/* Coro::AIO */
2121 2333
2170 2382
2171static int 2383static int
2172slf_check_aio_req (pTHX_ struct CoroSLF *frame) 2384slf_check_aio_req (pTHX_ struct CoroSLF *frame)
2173{ 2385{
2174 AV *state = (AV *)frame->data; 2386 AV *state = (AV *)frame->data;
2387
2388 /* if we are about to throw, return early */
2389 /* this does not cancel the aio request, but at least */
2390 /* it quickly returns */
2391 if (CORO_THROW)
2392 return 0;
2175 2393
2176 /* one element that is an RV? repeat! */ 2394 /* one element that is an RV? repeat! */
2177 if (AvFILLp (state) == 0 && SvROK (AvARRAY (state)[0])) 2395 if (AvFILLp (state) == 0 && SvROK (AvARRAY (state)[0]))
2178 return 1; 2396 return 1;
2179 2397
2376 for (i = 1; i < items; i++) 2594 for (i = 1; i < items; i++)
2377 av_push (coro->args, newSVsv (ST (i))); 2595 av_push (coro->args, newSVsv (ST (i)));
2378} 2596}
2379 OUTPUT: 2597 OUTPUT:
2380 RETVAL 2598 RETVAL
2381
2382void
2383_set_stacklevel (...)
2384 CODE:
2385 CORO_EXECUTE_SLF_XS (slf_init_set_stacklevel);
2386 2599
2387void 2600void
2388transfer (...) 2601transfer (...)
2389 PROTOTYPE: $$ 2602 PROTOTYPE: $$
2390 CODE: 2603 CODE:
2516throw (Coro::State self, SV *throw = &PL_sv_undef) 2729throw (Coro::State self, SV *throw = &PL_sv_undef)
2517 PROTOTYPE: $;$ 2730 PROTOTYPE: $;$
2518 CODE: 2731 CODE:
2519{ 2732{
2520 struct coro *current = SvSTATE_current; 2733 struct coro *current = SvSTATE_current;
2521 SV **throwp = self == current ? &coro_throw : &self->throw; 2734 SV **throwp = self == current ? &CORO_THROW : &self->except;
2522 SvREFCNT_dec (*throwp); 2735 SvREFCNT_dec (*throwp);
2523 *throwp = SvOK (throw) ? newSVsv (throw) : 0; 2736 *throwp = SvOK (throw) ? newSVsv (throw) : 0;
2524} 2737}
2525 2738
2526void 2739void
2615 coroapi.ready = api_ready; 2828 coroapi.ready = api_ready;
2616 coroapi.is_ready = api_is_ready; 2829 coroapi.is_ready = api_is_ready;
2617 coroapi.nready = coro_nready; 2830 coroapi.nready = coro_nready;
2618 coroapi.current = coro_current; 2831 coroapi.current = coro_current;
2619 2832
2620 GCoroAPI = &coroapi; 2833 /*GCoroAPI = &coroapi;*/
2621 sv_setiv (sv, (IV)&coroapi); 2834 sv_setiv (sv, (IV)&coroapi);
2622 SvREADONLY_on (sv); 2835 SvREADONLY_on (sv);
2623 } 2836 }
2624} 2837}
2625 2838
2761 api_trace (aTHX_ coro_current, 0); 2974 api_trace (aTHX_ coro_current, 0);
2762 2975
2763 av_push (av_async_pool, newSVsv (coro_current)); 2976 av_push (av_async_pool, newSVsv (coro_current));
2764} 2977}
2765 2978
2979SV *
2980rouse_cb ()
2981 PROTOTYPE:
2982 CODE:
2983 RETVAL = coro_new_rouse_cb (aTHX);
2984 OUTPUT:
2985 RETVAL
2986
2987void
2988rouse_wait (SV *cb = 0)
2989 PROTOTYPE: ;$
2990 PPCODE:
2991 CORO_EXECUTE_SLF_XS (slf_init_rouse_wait);
2992
2766 2993
2767MODULE = Coro::State PACKAGE = PerlIO::cede 2994MODULE = Coro::State PACKAGE = PerlIO::cede
2768 2995
2769BOOT: 2996BOOT:
2770 PerlIO_define_layer (aTHX_ &PerlIO_cede); 2997 PerlIO_define_layer (aTHX_ &PerlIO_cede);
2771 2998
2772 2999
2773MODULE = Coro::State PACKAGE = Coro::Semaphore 3000MODULE = Coro::State PACKAGE = Coro::Semaphore
2774 3001
2775SV * 3002SV *
2776new (SV *klass, SV *count_ = 0) 3003new (SV *klass, SV *count = 0)
2777 CODE: 3004 CODE:
2778{ 3005 RETVAL = sv_bless (
2779 /* a semaphore contains a counter IV in $sem->[0] and any waiters after that */ 3006 coro_waitarray_new (aTHX_ count && SvOK (count) ? SvIV (count) : 1),
2780 AV *av = newAV (); 3007 GvSTASH (CvGV (cv))
2781 SV **ary; 3008 );
3009 OUTPUT:
3010 RETVAL
2782 3011
2783 /* unfortunately, building manually saves memory */ 3012# helper for Coro::Channel
2784 Newx (ary, 2, SV *); 3013SV *
2785 AvALLOC (av) = ary; 3014_alloc (int count)
2786 AvARRAY (av) = ary; 3015 CODE:
2787 AvMAX (av) = 1; 3016 RETVAL = coro_waitarray_new (aTHX_ count);
2788 AvFILLp (av) = 0;
2789 ary [0] = newSViv (count_ && SvOK (count_) ? SvIV (count_) : 1);
2790
2791 RETVAL = sv_bless (newRV_noinc ((SV *)av), GvSTASH (CvGV (cv)));
2792}
2793 OUTPUT: 3017 OUTPUT:
2794 RETVAL 3018 RETVAL
2795 3019
2796SV * 3020SV *
2797count (SV *self) 3021count (SV *self)
2809 3033
2810void 3034void
2811down (SV *self) 3035down (SV *self)
2812 CODE: 3036 CODE:
2813 CORO_EXECUTE_SLF_XS (slf_init_semaphore_down); 3037 CORO_EXECUTE_SLF_XS (slf_init_semaphore_down);
3038
3039void
3040wait (SV *self)
3041 CODE:
3042 CORO_EXECUTE_SLF_XS (slf_init_semaphore_wait);
2814 3043
2815void 3044void
2816try (SV *self) 3045try (SV *self)
2817 PPCODE: 3046 PPCODE:
2818{ 3047{
2830 XSRETURN_NO; 3059 XSRETURN_NO;
2831} 3060}
2832 3061
2833void 3062void
2834waiters (SV *self) 3063waiters (SV *self)
2835 CODE: 3064 PPCODE:
2836{ 3065{
2837 AV *av = (AV *)SvRV (self); 3066 AV *av = (AV *)SvRV (self);
3067 int wcount = AvFILLp (av) + 1 - 1;
2838 3068
2839 if (GIMME_V == G_SCALAR) 3069 if (GIMME_V == G_SCALAR)
2840 XPUSHs (sv_2mortal (newSVsv (AvARRAY (av)[0]))); 3070 XPUSHs (sv_2mortal (newSViv (wcount)));
2841 else 3071 else
2842 { 3072 {
2843 int i; 3073 int i;
2844 EXTEND (SP, AvFILLp (av) + 1 - 1); 3074 EXTEND (SP, wcount);
2845 for (i = 1; i <= AvFILLp (av); ++i) 3075 for (i = 1; i <= wcount; ++i)
2846 PUSHs (newSVsv (AvARRAY (av)[i])); 3076 PUSHs (sv_2mortal (newRV_inc (AvARRAY (av)[i])));
2847 } 3077 }
2848} 3078}
3079
3080MODULE = Coro::State PACKAGE = Coro::Signal
3081
3082SV *
3083new (SV *klass)
3084 CODE:
3085 RETVAL = sv_bless (
3086 coro_waitarray_new (aTHX_ 0),
3087 GvSTASH (CvGV (cv))
3088 );
3089 OUTPUT:
3090 RETVAL
3091
3092void
3093wait (SV *self)
3094 CODE:
3095 CORO_EXECUTE_SLF_XS (slf_init_signal_wait);
3096
3097void
3098broadcast (SV *self)
3099 CODE:
3100{
3101 AV *av = (AV *)SvRV (self);
3102 coro_signal_wake (aTHX_ av, AvFILLp (av));
3103}
3104
3105void
3106send (SV *self)
3107 CODE:
3108{
3109 AV *av = (AV *)SvRV (self);
3110
3111 if (AvFILLp (av))
3112 coro_signal_wake (aTHX_ av, 1);
3113 else
3114 SvIVX (AvARRAY (av)[0]) = 1; /* remember the signal */
3115}
3116
3117IV
3118awaited (SV *self)
3119 CODE:
3120 RETVAL = AvFILLp ((AV *)SvRV (self)) + 1 - 1;
3121 OUTPUT:
3122 RETVAL
2849 3123
2850 3124
2851MODULE = Coro::State PACKAGE = Coro::AnyEvent 3125MODULE = Coro::State PACKAGE = Coro::AnyEvent
2852 3126
2853BOOT: 3127BOOT:
2868 sv_setsv (sv_activity, &PL_sv_undef); 3142 sv_setsv (sv_activity, &PL_sv_undef);
2869 if (coro_nready >= incede) 3143 if (coro_nready >= incede)
2870 { 3144 {
2871 PUSHMARK (SP); 3145 PUSHMARK (SP);
2872 PUTBACK; 3146 PUTBACK;
2873 call_pv ("Coro::AnyEvent::_activity", G_DISCARD | G_EVAL); 3147 call_pv ("Coro::AnyEvent::_activity", G_KEEPERR | G_EVAL | G_VOID | G_DISCARD);
2874 SPAGAIN;
2875 } 3148 }
2876 3149
2877 --incede; 3150 --incede;
2878} 3151}
2879 3152

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines