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.294 by root, Tue Nov 18 08:31:03 2008 UTC vs.
Revision 1.311 by root, Thu Nov 20 01:12:08 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
145#define expect_true(expr) expect ((expr) != 0, 1) 145#define expect_true(expr) expect ((expr) != 0, 1)
146 146
147#define NOINLINE attribute ((noinline)) 147#define NOINLINE attribute ((noinline))
148 148
149#include "CoroAPI.h" 149#include "CoroAPI.h"
150#define GCoroAPI (&coroapi) /* very sneaky */
150 151
151#ifdef USE_ITHREADS 152#ifdef USE_ITHREADS
152# if CORO_PTHREAD 153# if CORO_PTHREAD
153static void *coro_thx; 154static void *coro_thx;
154# endif 155# endif
245 /* state data */ 246 /* state data */
246 struct CoroSLF slf_frame; /* saved slf frame */ 247 struct CoroSLF slf_frame; /* saved slf frame */
247 AV *mainstack; 248 AV *mainstack;
248 perl_slots *slot; /* basically the saved sp */ 249 perl_slots *slot; /* basically the saved sp */
249 250
251 CV *startcv; /* the CV to execute */
250 AV *args; /* data associated with this coroutine (initial args) */ 252 AV *args; /* data associated with this coroutine (initial args) */
251 int refcnt; /* coroutines are refcounted, yes */ 253 int refcnt; /* coroutines are refcounted, yes */
252 int flags; /* CF_ flags */ 254 int flags; /* CF_ flags */
253 HV *hv; /* the perl hash associated with this coro, if any */ 255 HV *hv; /* the perl hash associated with this coro, if any */
254 void (*on_destroy)(pTHX_ struct coro *coro); 256 void (*on_destroy)(pTHX_ struct coro *coro);
255 257
256 /* statistics */ 258 /* statistics */
257 int usecount; /* number of transfers to this coro */ 259 int usecount; /* number of transfers to this coro */
258 260
259 /* coro process data */ 261 /* coro process data */
260 int prio; 262 int prio;
261 SV *throw; /* exception to be thrown */ 263 SV *except; /* exception to be thrown */
264 SV *rouse_cb;
262 265
263 /* async_pool */ 266 /* async_pool */
264 SV *saved_deffh; 267 SV *saved_deffh;
265 268
266 /* linked list */ 269 /* linked list */
272 275
273/* the following variables are effectively part of the perl context */ 276/* the following variables are effectively part of the perl context */
274/* and get copied between struct coro and these variables */ 277/* and get copied between struct coro and these variables */
275/* the mainr easonw e don't support windows process emulation */ 278/* the mainr easonw e don't support windows process emulation */
276static struct CoroSLF slf_frame; /* the current slf frame */ 279static struct CoroSLF slf_frame; /* the current slf frame */
277static SV *coro_throw;
278 280
279/** Coro ********************************************************************/ 281/** Coro ********************************************************************/
280 282
281#define PRIO_MAX 3 283#define PRIO_MAX 3
282#define PRIO_HIGH 1 284#define PRIO_HIGH 1
287 289
288/* for Coro.pm */ 290/* for Coro.pm */
289static SV *coro_current; 291static SV *coro_current;
290static SV *coro_readyhook; 292static SV *coro_readyhook;
291static AV *coro_ready [PRIO_MAX - PRIO_MIN + 1]; 293static AV *coro_ready [PRIO_MAX - PRIO_MIN + 1];
294static CV *cv_coro_run;
292static struct coro *coro_first; 295static struct coro *coro_first;
293#define coro_nready coroapi.nready 296#define coro_nready coroapi.nready
294 297
295/** lowlevel stuff **********************************************************/ 298/** lowlevel stuff **********************************************************/
296 299
320#if PERL_VERSION_ATLEAST (5,10,0) 323#if PERL_VERSION_ATLEAST (5,10,0)
321 /* silence stupid and wrong 5.10 warning that I am unable to switch off */ 324 /* silence stupid and wrong 5.10 warning that I am unable to switch off */
322 get_hv (name, create); 325 get_hv (name, create);
323#endif 326#endif
324 return get_hv (name, create); 327 return get_hv (name, create);
328}
329
330/* may croak */
331INLINE CV *
332coro_sv_2cv (pTHX_ SV *sv)
333{
334 HV *st;
335 GV *gvp;
336 return sv_2cv (sv, &st, &gvp, 0);
325} 337}
326 338
327static AV * 339static AV *
328coro_clone_padlist (pTHX_ CV *cv) 340coro_clone_padlist (pTHX_ CV *cv)
329{ 341{
448 else 460 else
449 { 461 {
450#if CORO_PREFER_PERL_FUNCTIONS 462#if CORO_PREFER_PERL_FUNCTIONS
451 /* this is probably cleaner? but also slower! */ 463 /* this is probably cleaner? but also slower! */
452 /* in practise, it seems to be less stable */ 464 /* in practise, it seems to be less stable */
453 CV *cp = Perl_cv_clone (cv); 465 CV *cp = Perl_cv_clone (aTHX_ cv);
454 CvPADLIST (cv) = CvPADLIST (cp); 466 CvPADLIST (cv) = CvPADLIST (cp);
455 CvPADLIST (cp) = 0; 467 CvPADLIST (cp) = 0;
456 SvREFCNT_dec (cp); 468 SvREFCNT_dec (cp);
457#else 469#else
458 CvPADLIST (cv) = coro_clone_padlist (aTHX_ cv); 470 CvPADLIST (cv) = coro_clone_padlist (aTHX_ cv);
511 523
512 PUTBACK; 524 PUTBACK;
513 } 525 }
514 526
515 slf_frame = c->slf_frame; 527 slf_frame = c->slf_frame;
516 coro_throw = c->throw; 528 CORO_THROW = c->except;
517} 529}
518 530
519static void 531static void
520save_perl (pTHX_ Coro__State c) 532save_perl (pTHX_ Coro__State c)
521{ 533{
522 c->throw = coro_throw; 534 c->except = CORO_THROW;
523 c->slf_frame = slf_frame; 535 c->slf_frame = slf_frame;
524 536
525 { 537 {
526 dSP; 538 dSP;
527 I32 cxix = cxstack_ix; 539 I32 cxix = cxstack_ix;
602 * of perl.c:init_stacks, except that it uses less memory 614 * of perl.c:init_stacks, except that it uses less memory
603 * on the (sometimes correct) assumption that coroutines do 615 * on the (sometimes correct) assumption that coroutines do
604 * not usually need a lot of stackspace. 616 * not usually need a lot of stackspace.
605 */ 617 */
606#if CORO_PREFER_PERL_FUNCTIONS 618#if CORO_PREFER_PERL_FUNCTIONS
607# define coro_init_stacks init_stacks 619# define coro_init_stacks(thx) init_stacks ()
608#else 620#else
609static void 621static void
610coro_init_stacks (pTHX) 622coro_init_stacks (pTHX)
611{ 623{
612 PL_curstackinfo = new_stackinfo(32, 8); 624 PL_curstackinfo = new_stackinfo(32, 8);
860 dSP; 872 dSP;
861 UNOP myop; 873 UNOP myop;
862 874
863 Zero (&myop, 1, UNOP); 875 Zero (&myop, 1, UNOP);
864 myop.op_next = Nullop; 876 myop.op_next = Nullop;
877 myop.op_type = OP_ENTERSUB;
865 myop.op_flags = OPf_WANT_VOID; 878 myop.op_flags = OPf_WANT_VOID;
866 879
867 PUSHMARK (SP); 880 PUSHMARK (SP);
868 XPUSHs (sv_2mortal (av_shift (GvAV (PL_defgv)))); 881 PUSHs ((SV *)coro->startcv);
869 PUTBACK; 882 PUTBACK;
870 PL_op = (OP *)&myop; 883 PL_op = (OP *)&myop;
871 PL_op = PL_ppaddr[OP_ENTERSUB](aTHX); 884 PL_op = PL_ppaddr[OP_ENTERSUB](aTHX);
872 SPAGAIN;
873 } 885 }
874 886
875 /* this newly created coroutine might be run on an existing cctx which most 887 /* 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. 888 * likely was suspended in pp_slf, so we have to emulate entering pp_slf here.
877 */ 889 */
880 892
881 /* and we have to provide the pp_slf op in any case, so pp_slf can skip it */ 893 /* 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; 894 coro_setup_op.op_next = PL_op;
883 coro_setup_op.op_type = OP_CUSTOM; 895 coro_setup_op.op_type = OP_CUSTOM;
884 coro_setup_op.op_ppaddr = pp_slf; 896 coro_setup_op.op_ppaddr = pp_slf;
885 /* no flags required, as an init function won't be called */ 897 /* no flags etc. required, as an init function won't be called */
886 898
887 PL_op = (OP *)&coro_setup_op; 899 PL_op = (OP *)&coro_setup_op;
888 900
889 /* copy throw, in case it was set before coro_setup */ 901 /* copy throw, in case it was set before coro_setup */
890 coro_throw = coro->throw; 902 CORO_THROW = coro->except;
891} 903}
892 904
893static void 905static void
894coro_destruct (pTHX_ struct coro *coro) 906coro_destruct (pTHX_ struct coro *coro)
895{ 907{
919 931
920 SvREFCNT_dec (PL_diehook); 932 SvREFCNT_dec (PL_diehook);
921 SvREFCNT_dec (PL_warnhook); 933 SvREFCNT_dec (PL_warnhook);
922 934
923 SvREFCNT_dec (coro->saved_deffh); 935 SvREFCNT_dec (coro->saved_deffh);
924 SvREFCNT_dec (coro_throw); 936 SvREFCNT_dec (coro->rouse_cb);
925 937
926 coro_destruct_stacks (aTHX); 938 coro_destruct_stacks (aTHX);
927} 939}
928 940
929INLINE void 941INLINE void
1016 SAVETMPS; 1028 SAVETMPS;
1017 EXTEND (SP, 3); 1029 EXTEND (SP, 3);
1018 PUSHMARK (SP); 1030 PUSHMARK (SP);
1019 PUSHs (&PL_sv_yes); 1031 PUSHs (&PL_sv_yes);
1020 PUSHs (fullname); 1032 PUSHs (fullname);
1021 PUSHs (CxHASARGS (cx) ? sv_2mortal (newRV_inc ((SV *)cx->blk_sub.argarray)) : &PL_sv_undef); 1033 PUSHs (CxHASARGS (cx) ? sv_2mortal (newRV_inc ((SV *)cx->blk_sub.argarray)) : &PL_sv_undef);
1022 PUTBACK; 1034 PUTBACK;
1023 cb = hv_fetch ((HV *)SvRV (coro_current), "_trace_sub_cb", sizeof ("_trace_sub_cb") - 1, 0); 1035 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); 1036 if (cb) call_sv (*cb, G_KEEPERR | G_EVAL | G_VOID | G_DISCARD);
1025 SPAGAIN; 1037 SPAGAIN;
1026 FREETMPS; 1038 FREETMPS;
1132 transfer_tail (aTHX); 1144 transfer_tail (aTHX);
1133 1145
1134 /* somebody or something will hit me for both perl_run and PL_restartop */ 1146 /* somebody or something will hit me for both perl_run and PL_restartop */
1135 PL_restartop = PL_op; 1147 PL_restartop = PL_op;
1136 perl_run (PL_curinterp); 1148 perl_run (PL_curinterp);
1149 /*
1150 * Unfortunately, there is no way to get at the return values of the
1151 * coro body here, as perl_run destroys these
1152 */
1137 1153
1138 /* 1154 /*
1139 * If perl-run returns we assume exit() was being called or the coro 1155 * 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) 1156 * 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 1157 * reason for perl_run to return. We try to exit by jumping to the
1433 1449
1434 coro->slot = 0; 1450 coro->slot = 0;
1435 } 1451 }
1436 1452
1437 cctx_destroy (coro->cctx); 1453 cctx_destroy (coro->cctx);
1454 SvREFCNT_dec (coro->startcv);
1438 SvREFCNT_dec (coro->args); 1455 SvREFCNT_dec (coro->args);
1456 SvREFCNT_dec (CORO_THROW);
1439 1457
1440 if (coro->next) coro->next->prev = coro->prev; 1458 if (coro->next) coro->next->prev = coro->prev;
1441 if (coro->prev) coro->prev->next = coro->next; 1459 if (coro->prev) coro->prev->next = coro->next;
1442 if (coro == coro_first) coro_first = coro->next; 1460 if (coro == coro_first) coro_first = coro->next;
1443 1461
1497 1515
1498 prepare_transfer (aTHX_ &ta, prev_sv, next_sv); 1516 prepare_transfer (aTHX_ &ta, prev_sv, next_sv);
1499 TRANSFER (ta, 1); 1517 TRANSFER (ta, 1);
1500} 1518}
1501 1519
1520/*****************************************************************************/
1521/* gensub: simple closure generation utility */
1522
1523#define GENSUB_ARG CvXSUBANY (cv).any_ptr
1524
1525/* create a closure from XS, returns a code reference */
1526/* the arg can be accessed via GENSUB_ARG from the callback */
1527/* the callback must use dXSARGS/XSRETURN */
1528static SV *
1529gensub (pTHX_ void (*xsub)(pTHX_ CV *), void *arg)
1530{
1531 CV *cv = (CV *)newSV (0);
1532
1533 sv_upgrade ((SV *)cv, SVt_PVCV);
1534
1535 CvANON_on (cv);
1536 CvISXSUB_on (cv);
1537 CvXSUB (cv) = xsub;
1538 GENSUB_ARG = arg;
1539
1540 return newRV_noinc ((SV *)cv);
1541}
1542
1502/** Coro ********************************************************************/ 1543/** Coro ********************************************************************/
1503 1544
1504INLINE void 1545INLINE void
1505coro_enq (pTHX_ struct coro *coro) 1546coro_enq (pTHX_ struct coro *coro)
1506{ 1547{
1703 if (coro->flags & CF_RUNNING) 1744 if (coro->flags & CF_RUNNING)
1704 PL_runops = RUNOPS_DEFAULT; 1745 PL_runops = RUNOPS_DEFAULT;
1705 else 1746 else
1706 coro->slot->runops = RUNOPS_DEFAULT; 1747 coro->slot->runops = RUNOPS_DEFAULT;
1707 } 1748 }
1749}
1750
1751/*****************************************************************************/
1752/* rouse callback */
1753
1754#define CORO_MAGIC_type_rouse PERL_MAGIC_ext
1755
1756static void
1757coro_rouse_callback (pTHX_ CV *cv)
1758{
1759 dXSARGS;
1760 SV *data = (SV *)GENSUB_ARG;
1761
1762 if (SvTYPE (SvRV (data)) != SVt_PVAV)
1763 {
1764 /* first call, set args */
1765 int i;
1766 AV *av = newAV ();
1767 SV *coro = SvRV (data);
1768
1769 SvRV_set (data, (SV *)av);
1770 api_ready (aTHX_ coro);
1771 SvREFCNT_dec (coro);
1772
1773 /* better take a full copy of the arguments */
1774 while (items--)
1775 av_store (av, items, newSVsv (ST (items)));
1776 }
1777
1778 XSRETURN_EMPTY;
1779}
1780
1781static int
1782slf_check_rouse_wait (pTHX_ struct CoroSLF *frame)
1783{
1784 SV *data = (SV *)frame->data;
1785
1786 if (CORO_THROW)
1787 return 0;
1788
1789 if (SvTYPE (SvRV (data)) != SVt_PVAV)
1790 return 1;
1791
1792 /* now push all results on the stack */
1793 {
1794 dSP;
1795 AV *av = (AV *)SvRV (data);
1796 int i;
1797
1798 EXTEND (SP, AvFILLp (av) + 1);
1799 for (i = 0; i <= AvFILLp (av); ++i)
1800 PUSHs (sv_2mortal (AvARRAY (av)[i]));
1801
1802 /* we have stolen the elements, so ste length to zero and free */
1803 AvFILLp (av) = -1;
1804 av_undef (av);
1805
1806 PUTBACK;
1807 }
1808
1809 return 0;
1810}
1811
1812static void
1813slf_init_rouse_wait (pTHX_ struct CoroSLF *frame, CV *cv, SV **arg, int items)
1814{
1815 SV *cb;
1816
1817 if (items)
1818 cb = arg [0];
1819 else
1820 {
1821 struct coro *coro = SvSTATE_current;
1822
1823 if (!coro->rouse_cb)
1824 croak ("Coro::rouse_wait called without rouse callback, and no default rouse callback found either,");
1825
1826 cb = sv_2mortal (coro->rouse_cb);
1827 coro->rouse_cb = 0;
1828 }
1829
1830 if (!SvROK (cb)
1831 || SvTYPE (SvRV (cb)) != SVt_PVCV
1832 || CvXSUB ((CV *)SvRV (cb)) != coro_rouse_callback)
1833 croak ("Coro::rouse_wait called with illegal callback argument,");
1834
1835 {
1836 CV *cv = (CV *)SvRV (cb); /* for GENSUB_ARG */
1837 SV *data = (SV *)GENSUB_ARG;
1838
1839 frame->data = (void *)data;
1840 frame->prepare = SvTYPE (SvRV (data)) == SVt_PVAV ? prepare_nop : prepare_schedule;
1841 frame->check = slf_check_rouse_wait;
1842 }
1843}
1844
1845static SV *
1846coro_new_rouse_cb (pTHX)
1847{
1848 HV *hv = (HV *)SvRV (coro_current);
1849 struct coro *coro = SvSTATE_hv (hv);
1850 SV *data = newRV_inc ((SV *)hv);
1851 SV *cb = gensub (aTHX_ coro_rouse_callback, (void *)data);
1852
1853 sv_magicext (SvRV (cb), data, CORO_MAGIC_type_rouse, 0, 0, 0);
1854 SvREFCNT_dec (data); /* magicext increases the refcount */
1855
1856 SvREFCNT_dec (coro->rouse_cb);
1857 coro->rouse_cb = SvREFCNT_inc_NN (cb);
1858
1859 return cb;
1708} 1860}
1709 1861
1710/*****************************************************************************/ 1862/*****************************************************************************/
1711/* schedule-like-function opcode (SLF) */ 1863/* schedule-like-function opcode (SLF) */
1712 1864
1839 } 1991 }
1840 while (slf_frame.check (aTHX_ &slf_frame)); 1992 while (slf_frame.check (aTHX_ &slf_frame));
1841 1993
1842 slf_frame.prepare = 0; /* invalidate the frame, we are done processing it */ 1994 slf_frame.prepare = 0; /* invalidate the frame, we are done processing it */
1843 1995
1996 /* exception handling */
1997 if (expect_false (CORO_THROW))
1998 {
1999 SV *exception = sv_2mortal (CORO_THROW);
2000
2001 CORO_THROW = 0;
2002 sv_setsv (ERRSV, exception);
2003 croak (0);
2004 }
2005
1844 /* return value handling - mostly like entersub */ 2006 /* return value handling - mostly like entersub */
1845 /* make sure we put something on the stack in scalar context */ 2007 /* make sure we put something on the stack in scalar context */
1846 if (GIMME_V == G_SCALAR) 2008 if (GIMME_V == G_SCALAR)
1847 { 2009 {
1848 dSP; 2010 dSP;
1854 bot [1] = *sp; 2016 bot [1] = *sp;
1855 2017
1856 SP = bot + 1; 2018 SP = bot + 1;
1857 2019
1858 PUTBACK; 2020 PUTBACK;
1859 }
1860
1861 /* exception handling */
1862 if (expect_false (coro_throw))
1863 {
1864 SV *exception = sv_2mortal (coro_throw);
1865
1866 coro_throw = 0;
1867 sv_setsv (ERRSV, exception);
1868 croak (0);
1869 } 2021 }
1870 2022
1871 return NORMAL; 2023 return NORMAL;
1872} 2024}
1873 2025
1995 PerlIOBuf_get_cnt, 2147 PerlIOBuf_get_cnt,
1996 PerlIOBuf_set_ptrcnt, 2148 PerlIOBuf_set_ptrcnt,
1997}; 2149};
1998 2150
1999/*****************************************************************************/ 2151/*****************************************************************************/
2152/* Coro::Semaphore & Coro::Signal */
2153
2154static SV *
2155coro_waitarray_new (pTHX_ int count)
2156{
2157 /* a semaphore contains a counter IV in $sem->[0] and any waiters after that */
2158 AV *av = newAV ();
2159 SV **ary;
2160
2161 /* unfortunately, building manually saves memory */
2162 Newx (ary, 2, SV *);
2163 AvALLOC (av) = ary;
2164 /*AvARRAY (av) = ary;*/
2165 SvPVX ((SV *)av) = (char *)ary; /* 5.8.8 needs this syntax instead of AvARRAY = ary */
2166 AvMAX (av) = 1;
2167 AvFILLp (av) = 0;
2168 ary [0] = newSViv (count);
2169
2170 return newRV_noinc ((SV *)av);
2171}
2172
2000/* Coro::Semaphore */ 2173/* semaphore */
2001 2174
2002static void 2175static void
2003coro_semaphore_adjust (pTHX_ AV *av, IV adjust) 2176coro_semaphore_adjust (pTHX_ AV *av, IV adjust)
2004{ 2177{
2005 SV *count_sv = AvARRAY (av)[0]; 2178 SV *count_sv = AvARRAY (av)[0];
2017 AvARRAY (av)[0] = AvARRAY (av)[1]; 2190 AvARRAY (av)[0] = AvARRAY (av)[1];
2018 AvARRAY (av)[1] = count_sv; 2191 AvARRAY (av)[1] = count_sv;
2019 cb = av_shift (av); 2192 cb = av_shift (av);
2020 2193
2021 if (SvOBJECT (cb)) 2194 if (SvOBJECT (cb))
2195 {
2022 api_ready (aTHX_ cb); 2196 api_ready (aTHX_ cb);
2023 else 2197 --count;
2024 croak ("callbacks not yet supported"); 2198 }
2199 else if (SvTYPE (cb) == SVt_PVCV)
2200 {
2201 dSP;
2202 PUSHMARK (SP);
2203 XPUSHs (sv_2mortal (newRV_inc ((SV *)av)));
2204 PUTBACK;
2205 call_sv (cb, G_VOID | G_DISCARD | G_EVAL | G_KEEPERR);
2206 }
2025 2207
2026 SvREFCNT_dec (cb); 2208 SvREFCNT_dec (cb);
2027
2028 --count;
2029 } 2209 }
2030} 2210}
2031 2211
2032static void 2212static void
2033coro_semaphore_on_destroy (pTHX_ struct coro *coro) 2213coro_semaphore_on_destroy (pTHX_ struct coro *coro)
2035 /* call $sem->adjust (0) to possibly wake up some other waiters */ 2215 /* call $sem->adjust (0) to possibly wake up some other waiters */
2036 coro_semaphore_adjust (aTHX_ (AV *)coro->slf_frame.data, 0); 2216 coro_semaphore_adjust (aTHX_ (AV *)coro->slf_frame.data, 0);
2037} 2217}
2038 2218
2039static int 2219static int
2040slf_check_semaphore_down (pTHX_ struct CoroSLF *frame) 2220slf_check_semaphore_down_or_wait (pTHX_ struct CoroSLF *frame, int acquire)
2041{ 2221{
2042 AV *av = (AV *)frame->data; 2222 AV *av = (AV *)frame->data;
2043 SV *count_sv = AvARRAY (av)[0]; 2223 SV *count_sv = AvARRAY (av)[0];
2044 2224
2225 /* if we are about to throw, don't actually acquire the lock, just throw */
2226 if (CORO_THROW)
2227 return 0;
2045 if (SvIVX (count_sv) > 0) 2228 else if (SvIVX (count_sv) > 0)
2046 { 2229 {
2047 SvSTATE_current->on_destroy = 0; 2230 SvSTATE_current->on_destroy = 0;
2231
2232 if (acquire)
2048 SvIVX (count_sv) = SvIVX (count_sv) - 1; 2233 SvIVX (count_sv) = SvIVX (count_sv) - 1;
2234 else
2235 coro_semaphore_adjust (aTHX_ av, 0);
2236
2049 return 0; 2237 return 0;
2050 } 2238 }
2051 else 2239 else
2052 { 2240 {
2053 int i; 2241 int i;
2062 av_push (av, SvREFCNT_inc (SvRV (coro_current))); 2250 av_push (av, SvREFCNT_inc (SvRV (coro_current)));
2063 return 1; 2251 return 1;
2064 } 2252 }
2065} 2253}
2066 2254
2067static void 2255static int
2256slf_check_semaphore_down (pTHX_ struct CoroSLF *frame)
2257{
2258 return slf_check_semaphore_down_or_wait (aTHX_ frame, 1);
2259}
2260
2261static int
2262slf_check_semaphore_wait (pTHX_ struct CoroSLF *frame)
2263{
2264 return slf_check_semaphore_down_or_wait (aTHX_ frame, 0);
2265}
2266
2267static void
2068slf_init_semaphore_down (pTHX_ struct CoroSLF *frame, CV *cv, SV **arg, int items) 2268slf_init_semaphore_down_or_wait (pTHX_ struct CoroSLF *frame, CV *cv, SV **arg, int items)
2069{ 2269{
2070 AV *av = (AV *)SvRV (arg [0]); 2270 AV *av = (AV *)SvRV (arg [0]);
2071 2271
2072 if (SvIVX (AvARRAY (av)[0]) > 0) 2272 if (SvIVX (AvARRAY (av)[0]) > 0)
2073 { 2273 {
2074 frame->data = (void *)av; 2274 frame->data = (void *)av;
2075 frame->prepare = prepare_nop; 2275 frame->prepare = prepare_nop;
2076 SvSTATE_current->on_destroy = coro_semaphore_on_destroy;
2077 } 2276 }
2078 else 2277 else
2079 { 2278 {
2080 av_push (av, SvREFCNT_inc (SvRV (coro_current))); 2279 av_push (av, SvREFCNT_inc (SvRV (coro_current)));
2081 2280
2082 frame->data = (void *)sv_2mortal (SvREFCNT_inc ((SV *)av)); 2281 frame->data = (void *)sv_2mortal (SvREFCNT_inc ((SV *)av));
2083 frame->prepare = prepare_schedule; 2282 frame->prepare = prepare_schedule;
2084 2283
2085 /* to avoid race conditions when a woken-up coro gets terminated */ 2284 /* to avoid race conditions when a woken-up coro gets terminated */
2086 /* we arrange for a temporary on_destroy that calls adjust (0) */ 2285 /* we arrange for a temporary on_destroy that calls adjust (0) */
2087 assert (!SvSTATE_current->on_destroy);//D
2088 SvSTATE_current->on_destroy = coro_semaphore_on_destroy; 2286 SvSTATE_current->on_destroy = coro_semaphore_on_destroy;
2089 } 2287 }
2288}
2090 2289
2290static void
2291slf_init_semaphore_down (pTHX_ struct CoroSLF *frame, CV *cv, SV **arg, int items)
2292{
2293 slf_init_semaphore_down_or_wait (aTHX_ frame, cv, arg, items);
2091 frame->check = slf_check_semaphore_down; 2294 frame->check = slf_check_semaphore_down;
2092
2093} 2295}
2094 2296
2095/*****************************************************************************/ 2297static void
2096/* gensub: simple closure generation utility */ 2298slf_init_semaphore_wait (pTHX_ struct CoroSLF *frame, CV *cv, SV **arg, int items)
2097
2098#define GENSUB_ARG CvXSUBANY (cv).any_ptr
2099
2100/* create a closure from XS, returns a code reference */
2101/* the arg can be accessed via GENSUB_ARG from the callback */
2102/* the callback must use dXSARGS/XSRETURN */
2103static SV *
2104gensub (pTHX_ void (*xsub)(pTHX_ CV *), void *arg)
2105{ 2299{
2106 CV *cv = (CV *)newSV (0); 2300 if (items >= 2)
2301 {
2302 /* callback form */
2303 AV *av = (AV *)SvRV (arg [0]);
2304 CV *cb_cv = coro_sv_2cv (aTHX_ arg [1]);
2107 2305
2108 sv_upgrade ((SV *)cv, SVt_PVCV); 2306 av_push (av, (SV *)SvREFCNT_inc_NN (cb_cv));
2109 2307
2110 CvANON_on (cv); 2308 if (SvIVX (AvARRAY (av)[0]) > 0)
2111 CvISXSUB_on (cv); 2309 coro_semaphore_adjust (aTHX_ av, 0);
2112 CvXSUB (cv) = xsub;
2113 GENSUB_ARG = arg;
2114 2310
2115 return newRV_noinc ((SV *)cv); 2311 frame->prepare = prepare_nop;
2312 frame->check = slf_check_nop;
2313 }
2314 else
2315 {
2316 slf_init_semaphore_down_or_wait (aTHX_ frame, cv, arg, items);
2317 frame->check = slf_check_semaphore_wait;
2318 }
2319}
2320
2321/* signal */
2322
2323static void
2324coro_signal_wake (pTHX_ AV *av, int count)
2325{
2326 SvIVX (AvARRAY (av)[0]) = 0;
2327
2328 /* now signal count waiters */
2329 while (count > 0 && AvFILLp (av) > 0)
2330 {
2331 SV *cb;
2332
2333 /* swap first two elements so we can shift a waiter */
2334 cb = AvARRAY (av)[0];
2335 AvARRAY (av)[0] = AvARRAY (av)[1];
2336 AvARRAY (av)[1] = cb;
2337
2338 cb = av_shift (av);
2339
2340 api_ready (aTHX_ cb);
2341 sv_setiv (cb, 0); /* signal waiter */
2342 SvREFCNT_dec (cb);
2343
2344 --count;
2345 }
2346}
2347
2348static int
2349slf_check_signal_wait (pTHX_ struct CoroSLF *frame)
2350{
2351 /* if we are about to throw, also stop waiting */
2352 return SvROK ((SV *)frame->data) && !CORO_THROW;
2353}
2354
2355static void
2356slf_init_signal_wait (pTHX_ struct CoroSLF *frame, CV *cv, SV **arg, int items)
2357{
2358 AV *av = (AV *)SvRV (arg [0]);
2359
2360 if (SvIVX (AvARRAY (av)[0]))
2361 {
2362 SvIVX (AvARRAY (av)[0]) = 0;
2363 frame->prepare = prepare_nop;
2364 frame->check = slf_check_nop;
2365 }
2366 else
2367 {
2368 SV *waiter = newRV_inc (SvRV (coro_current)); /* owned by signal av */
2369
2370 av_push (av, waiter);
2371
2372 frame->data = (void *)sv_2mortal (SvREFCNT_inc_NN (waiter)); /* owned by process */
2373 frame->prepare = prepare_schedule;
2374 frame->check = slf_check_signal_wait;
2375 }
2116} 2376}
2117 2377
2118/*****************************************************************************/ 2378/*****************************************************************************/
2119/* Coro::AIO */ 2379/* Coro::AIO */
2120 2380
2169 2429
2170static int 2430static int
2171slf_check_aio_req (pTHX_ struct CoroSLF *frame) 2431slf_check_aio_req (pTHX_ struct CoroSLF *frame)
2172{ 2432{
2173 AV *state = (AV *)frame->data; 2433 AV *state = (AV *)frame->data;
2434
2435 /* if we are about to throw, return early */
2436 /* this does not cancel the aio request, but at least */
2437 /* it quickly returns */
2438 if (CORO_THROW)
2439 return 0;
2174 2440
2175 /* one element that is an RV? repeat! */ 2441 /* one element that is an RV? repeat! */
2176 if (AvFILLp (state) == 0 && SvROK (AvARRAY (state)[0])) 2442 if (AvFILLp (state) == 0 && SvROK (AvARRAY (state)[0]))
2177 return 1; 2443 return 1;
2178 2444
2349 assert (("PRIO_NORMAL must be 0", !PRIO_NORMAL)); 2615 assert (("PRIO_NORMAL must be 0", !PRIO_NORMAL));
2350} 2616}
2351 2617
2352SV * 2618SV *
2353new (char *klass, ...) 2619new (char *klass, ...)
2620 ALIAS:
2621 Coro::new = 1
2354 CODE: 2622 CODE:
2355{ 2623{
2356 struct coro *coro; 2624 struct coro *coro;
2357 MAGIC *mg; 2625 MAGIC *mg;
2358 HV *hv; 2626 HV *hv;
2627 CV *cb;
2359 int i; 2628 int i;
2629
2630 if (items > 1)
2631 {
2632 cb = coro_sv_2cv (aTHX_ ST (1));
2633
2634 if (!ix)
2635 {
2636 if (CvISXSUB (cb))
2637 croak ("Coro::State doesn't support XS functions as coroutine start, caught");
2638
2639 if (!CvROOT (cb))
2640 croak ("Coro::State doesn't support autoloaded or undefined functions as coroutine start, caught");
2641 }
2642 }
2360 2643
2361 Newz (0, coro, 1, struct coro); 2644 Newz (0, coro, 1, struct coro);
2362 coro->args = newAV (); 2645 coro->args = newAV ();
2363 coro->flags = CF_NEW; 2646 coro->flags = CF_NEW;
2364 2647
2369 coro->hv = hv = newHV (); 2652 coro->hv = hv = newHV ();
2370 mg = sv_magicext ((SV *)hv, 0, CORO_MAGIC_type_state, &coro_state_vtbl, (char *)coro, 0); 2653 mg = sv_magicext ((SV *)hv, 0, CORO_MAGIC_type_state, &coro_state_vtbl, (char *)coro, 0);
2371 mg->mg_flags |= MGf_DUP; 2654 mg->mg_flags |= MGf_DUP;
2372 RETVAL = sv_bless (newRV_noinc ((SV *)hv), gv_stashpv (klass, 1)); 2655 RETVAL = sv_bless (newRV_noinc ((SV *)hv), gv_stashpv (klass, 1));
2373 2656
2657 if (items > 1)
2658 {
2374 av_extend (coro->args, items - 1); 2659 av_extend (coro->args, items - 1 + ix);
2660
2661 if (ix)
2662 {
2663 av_push (coro->args, SvREFCNT_inc_NN ((SV *)cb));
2664 cb = cv_coro_run;
2665 }
2666
2667 coro->startcv = (CV *)SvREFCNT_inc_NN ((SV *)cb);
2668
2375 for (i = 1; i < items; i++) 2669 for (i = 2; i < items; i++)
2376 av_push (coro->args, newSVsv (ST (i))); 2670 av_push (coro->args, newSVsv (ST (i)));
2671 }
2377} 2672}
2378 OUTPUT: 2673 OUTPUT:
2379 RETVAL 2674 RETVAL
2380 2675
2381void 2676void
2510throw (Coro::State self, SV *throw = &PL_sv_undef) 2805throw (Coro::State self, SV *throw = &PL_sv_undef)
2511 PROTOTYPE: $;$ 2806 PROTOTYPE: $;$
2512 CODE: 2807 CODE:
2513{ 2808{
2514 struct coro *current = SvSTATE_current; 2809 struct coro *current = SvSTATE_current;
2515 SV **throwp = self == current ? &coro_throw : &self->throw; 2810 SV **throwp = self == current ? &CORO_THROW : &self->except;
2516 SvREFCNT_dec (*throwp); 2811 SvREFCNT_dec (*throwp);
2517 *throwp = SvOK (throw) ? newSVsv (throw) : 0; 2812 *throwp = SvOK (throw) ? newSVsv (throw) : 0;
2518} 2813}
2519 2814
2520void 2815void
2582 int i; 2877 int i;
2583 2878
2584 av_async_pool = coro_get_av (aTHX_ "Coro::async_pool", TRUE); 2879 av_async_pool = coro_get_av (aTHX_ "Coro::async_pool", TRUE);
2585 sv_pool_rss = coro_get_sv (aTHX_ "Coro::POOL_RSS" , TRUE); 2880 sv_pool_rss = coro_get_sv (aTHX_ "Coro::POOL_RSS" , TRUE);
2586 sv_pool_size = coro_get_sv (aTHX_ "Coro::POOL_SIZE" , TRUE); 2881 sv_pool_size = coro_get_sv (aTHX_ "Coro::POOL_SIZE" , TRUE);
2587 2882 cv_coro_run = get_cv ( "Coro::_terminate", GV_ADD);
2588 coro_current = coro_get_sv (aTHX_ "Coro::current", FALSE); 2883 coro_current = coro_get_sv (aTHX_ "Coro::current" , FALSE);
2589 SvREADONLY_on (coro_current); 2884 SvREADONLY_on (coro_current);
2590 2885
2591 coro_stash = gv_stashpv ("Coro", TRUE); 2886 coro_stash = gv_stashpv ("Coro", TRUE);
2592 2887
2593 newCONSTSUB (coro_stash, "PRIO_MAX", newSViv (PRIO_MAX)); 2888 newCONSTSUB (coro_stash, "PRIO_MAX", newSViv (PRIO_MAX));
2609 coroapi.ready = api_ready; 2904 coroapi.ready = api_ready;
2610 coroapi.is_ready = api_is_ready; 2905 coroapi.is_ready = api_is_ready;
2611 coroapi.nready = coro_nready; 2906 coroapi.nready = coro_nready;
2612 coroapi.current = coro_current; 2907 coroapi.current = coro_current;
2613 2908
2614 GCoroAPI = &coroapi; 2909 /*GCoroAPI = &coroapi;*/
2615 sv_setiv (sv, (IV)&coroapi); 2910 sv_setiv (sv, (IV)&coroapi);
2616 SvREADONLY_on (sv); 2911 SvREADONLY_on (sv);
2617 } 2912 }
2618} 2913}
2619 2914
2755 api_trace (aTHX_ coro_current, 0); 3050 api_trace (aTHX_ coro_current, 0);
2756 3051
2757 av_push (av_async_pool, newSVsv (coro_current)); 3052 av_push (av_async_pool, newSVsv (coro_current));
2758} 3053}
2759 3054
3055SV *
3056rouse_cb ()
3057 PROTOTYPE:
3058 CODE:
3059 RETVAL = coro_new_rouse_cb (aTHX);
3060 OUTPUT:
3061 RETVAL
3062
3063void
3064rouse_wait (...)
3065 PROTOTYPE: ;$
3066 PPCODE:
3067 CORO_EXECUTE_SLF_XS (slf_init_rouse_wait);
3068
2760 3069
2761MODULE = Coro::State PACKAGE = PerlIO::cede 3070MODULE = Coro::State PACKAGE = PerlIO::cede
2762 3071
2763BOOT: 3072BOOT:
2764 PerlIO_define_layer (aTHX_ &PerlIO_cede); 3073 PerlIO_define_layer (aTHX_ &PerlIO_cede);
2765 3074
2766 3075
2767MODULE = Coro::State PACKAGE = Coro::Semaphore 3076MODULE = Coro::State PACKAGE = Coro::Semaphore
2768 3077
2769SV * 3078SV *
2770new (SV *klass, SV *count_ = 0) 3079new (SV *klass, SV *count = 0)
2771 CODE: 3080 CODE:
2772{ 3081 RETVAL = sv_bless (
2773 /* a semaphore contains a counter IV in $sem->[0] and any waiters after that */ 3082 coro_waitarray_new (aTHX_ count && SvOK (count) ? SvIV (count) : 1),
2774 AV *av = newAV (); 3083 GvSTASH (CvGV (cv))
2775 SV **ary; 3084 );
3085 OUTPUT:
3086 RETVAL
2776 3087
2777 /* unfortunately, building manually saves memory */ 3088# helper for Coro::Channel
2778 Newx (ary, 2, SV *); 3089SV *
2779 AvALLOC (av) = ary; 3090_alloc (int count)
2780 AvARRAY (av) = ary; 3091 CODE:
2781 AvMAX (av) = 1; 3092 RETVAL = coro_waitarray_new (aTHX_ count);
2782 AvFILLp (av) = 0;
2783 ary [0] = newSViv (count_ && SvOK (count_) ? SvIV (count_) : 1);
2784
2785 RETVAL = sv_bless (newRV_noinc ((SV *)av), GvSTASH (CvGV (cv)));
2786}
2787 OUTPUT: 3093 OUTPUT:
2788 RETVAL 3094 RETVAL
2789 3095
2790SV * 3096SV *
2791count (SV *self) 3097count (SV *self)
2800 adjust = 1 3106 adjust = 1
2801 CODE: 3107 CODE:
2802 coro_semaphore_adjust (aTHX_ (AV *)SvRV (self), ix ? adjust : 1); 3108 coro_semaphore_adjust (aTHX_ (AV *)SvRV (self), ix ? adjust : 1);
2803 3109
2804void 3110void
2805down (SV *self) 3111down (...)
2806 CODE: 3112 CODE:
2807 CORO_EXECUTE_SLF_XS (slf_init_semaphore_down); 3113 CORO_EXECUTE_SLF_XS (slf_init_semaphore_down);
3114
3115void
3116wait (...)
3117 CODE:
3118 CORO_EXECUTE_SLF_XS (slf_init_semaphore_wait);
2808 3119
2809void 3120void
2810try (SV *self) 3121try (SV *self)
2811 PPCODE: 3122 PPCODE:
2812{ 3123{
2824 XSRETURN_NO; 3135 XSRETURN_NO;
2825} 3136}
2826 3137
2827void 3138void
2828waiters (SV *self) 3139waiters (SV *self)
2829 CODE: 3140 PPCODE:
2830{ 3141{
2831 AV *av = (AV *)SvRV (self); 3142 AV *av = (AV *)SvRV (self);
3143 int wcount = AvFILLp (av) + 1 - 1;
2832 3144
2833 if (GIMME_V == G_SCALAR) 3145 if (GIMME_V == G_SCALAR)
2834 XPUSHs (sv_2mortal (newSVsv (AvARRAY (av)[0]))); 3146 XPUSHs (sv_2mortal (newSViv (wcount)));
2835 else 3147 else
2836 { 3148 {
2837 int i; 3149 int i;
2838 EXTEND (SP, AvFILLp (av) + 1 - 1); 3150 EXTEND (SP, wcount);
2839 for (i = 1; i <= AvFILLp (av); ++i) 3151 for (i = 1; i <= wcount; ++i)
2840 PUSHs (sv_2mortal (newRV_inc (AvARRAY (av)[i]))); 3152 PUSHs (sv_2mortal (newRV_inc (AvARRAY (av)[i])));
2841 } 3153 }
2842} 3154}
3155
3156MODULE = Coro::State PACKAGE = Coro::Signal
3157
3158SV *
3159new (SV *klass)
3160 CODE:
3161 RETVAL = sv_bless (
3162 coro_waitarray_new (aTHX_ 0),
3163 GvSTASH (CvGV (cv))
3164 );
3165 OUTPUT:
3166 RETVAL
3167
3168void
3169wait (...)
3170 CODE:
3171 CORO_EXECUTE_SLF_XS (slf_init_signal_wait);
3172
3173void
3174broadcast (SV *self)
3175 CODE:
3176{
3177 AV *av = (AV *)SvRV (self);
3178 coro_signal_wake (aTHX_ av, AvFILLp (av));
3179}
3180
3181void
3182send (SV *self)
3183 CODE:
3184{
3185 AV *av = (AV *)SvRV (self);
3186
3187 if (AvFILLp (av))
3188 coro_signal_wake (aTHX_ av, 1);
3189 else
3190 SvIVX (AvARRAY (av)[0]) = 1; /* remember the signal */
3191}
3192
3193IV
3194awaited (SV *self)
3195 CODE:
3196 RETVAL = AvFILLp ((AV *)SvRV (self)) + 1 - 1;
3197 OUTPUT:
3198 RETVAL
2843 3199
2844 3200
2845MODULE = Coro::State PACKAGE = Coro::AnyEvent 3201MODULE = Coro::State PACKAGE = Coro::AnyEvent
2846 3202
2847BOOT: 3203BOOT:
2875 3231
2876void 3232void
2877_register (char *target, char *proto, SV *req) 3233_register (char *target, char *proto, SV *req)
2878 CODE: 3234 CODE:
2879{ 3235{
2880 HV *st; 3236 CV *req_cv = coro_sv_2cv (aTHX_ req);
2881 GV *gvp;
2882 CV *req_cv = sv_2cv (req, &st, &gvp, 0);
2883 /* newXSproto doesn't return the CV on 5.8 */ 3237 /* newXSproto doesn't return the CV on 5.8 */
2884 CV *slf_cv = newXS (target, coro_aio_req_xs, __FILE__); 3238 CV *slf_cv = newXS (target, coro_aio_req_xs, __FILE__);
2885 sv_setpv ((SV *)slf_cv, proto); 3239 sv_setpv ((SV *)slf_cv, proto);
2886 sv_magicext ((SV *)slf_cv, (SV *)req_cv, CORO_MAGIC_type_aio, 0, 0, 0); 3240 sv_magicext ((SV *)slf_cv, (SV *)req_cv, CORO_MAGIC_type_aio, 0, 0, 0);
2887} 3241}

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines