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.274 by root, Sat Nov 15 00:08:30 2008 UTC vs.
Revision 1.283 by root, Sun Nov 16 11:12:57 2008 UTC

… …
142#define NOINLINE attribute ((noinline)) 142#define NOINLINE attribute ((noinline))
143 143
144#include "CoroAPI.h" 144#include "CoroAPI.h"
145 145
146#ifdef USE_ITHREADS 146#ifdef USE_ITHREADS
147
148static perl_mutex coro_lock;
149# define LOCK do { MUTEX_LOCK (&coro_lock); } while (0)
150# define UNLOCK do { MUTEX_UNLOCK (&coro_lock); } while (0)
151# if CORO_PTHREAD 147# if CORO_PTHREAD
152static void *coro_thx; 148static void *coro_thx;
153# endif 149# endif
154
155#else
156
157# define LOCK (void)0
158# define UNLOCK (void)0
159
160#endif 150#endif
161
162# undef LOCK
163# define LOCK (void)0
164# undef UNLOCK
165# define UNLOCK (void)0
166 151
167/* helper storage struct for Coro::AIO */ 152/* helper storage struct for Coro::AIO */
168struct io_state 153struct io_state
169{ 154{
170 AV *res; 155 AV *res;
… …
181static struct CoroAPI coroapi; 166static struct CoroAPI coroapi;
182static AV *main_mainstack; /* used to differentiate between $main and others */ 167static AV *main_mainstack; /* used to differentiate between $main and others */
183static JMPENV *main_top_env; 168static JMPENV *main_top_env;
184static HV *coro_state_stash, *coro_stash; 169static HV *coro_state_stash, *coro_stash;
185static volatile SV *coro_mortal; /* will be freed/thrown after next transfer */ 170static volatile SV *coro_mortal; /* will be freed/thrown after next transfer */
186static volatile struct coro *transfer_next;
187 171
188static GV *irsgv; /* $/ */ 172static GV *irsgv; /* $/ */
189static GV *stdoutgv; /* *STDOUT */ 173static GV *stdoutgv; /* *STDOUT */
190static SV *rv_diehook; 174static SV *rv_diehook;
191static SV *rv_warnhook; 175static SV *rv_warnhook;
… …
266 250
267 AV *args; /* data associated with this coroutine (initial args) */ 251 AV *args; /* data associated with this coroutine (initial args) */
268 int refcnt; /* coroutines are refcounted, yes */ 252 int refcnt; /* coroutines are refcounted, yes */
269 int flags; /* CF_ flags */ 253 int flags; /* CF_ flags */
270 HV *hv; /* the perl hash associated with this coro, if any */ 254 HV *hv; /* the perl hash associated with this coro, if any */
255 void (*on_destroy)(pTHX_ struct coro *coro);
271 256
272 /* statistics */ 257 /* statistics */
273 int usecount; /* number of transfers to this coro */ 258 int usecount; /* number of transfers to this coro */
274 259
275 /* coro process data */ 260 /* coro process data */
… …
403static MGVTBL coro_cv_vtbl = { 388static MGVTBL coro_cv_vtbl = {
404 0, 0, 0, 0, 389 0, 0, 0, 0,
405 coro_cv_free 390 coro_cv_free
406}; 391};
407 392
408#define CORO_MAGIC(sv, type) \ 393#define CORO_MAGIC(sv, type) \
409 SvMAGIC (sv) \ 394 expect_true (SvMAGIC (sv)) \
410 ? SvMAGIC (sv)->mg_type == type \ 395 ? expect_true (SvMAGIC (sv)->mg_type == type) \
411 ? SvMAGIC (sv) \ 396 ? SvMAGIC (sv) \
412 : mg_find (sv, type) \ 397 : mg_find (sv, type) \
413 : 0 398 : 0
414 399
415#define CORO_MAGIC_cv(cv) CORO_MAGIC (((SV *)(cv)), CORO_MAGIC_type_cv) 400#define CORO_MAGIC_cv(cv) CORO_MAGIC (((SV *)(cv)), CORO_MAGIC_type_cv)
416#define CORO_MAGIC_state(sv) CORO_MAGIC (((SV *)(sv)), CORO_MAGIC_type_state) 401#define CORO_MAGIC_state(sv) CORO_MAGIC (((SV *)(sv)), CORO_MAGIC_type_state)
417 402
… …
438 mg = CORO_MAGIC_state (coro); 423 mg = CORO_MAGIC_state (coro);
439 return (struct coro *)mg->mg_ptr; 424 return (struct coro *)mg->mg_ptr;
440} 425}
441 426
442#define SvSTATE(sv) SvSTATE_ (aTHX_ (sv)) 427#define SvSTATE(sv) SvSTATE_ (aTHX_ (sv))
428
429/* fastert than SvSTATE, but expects a coroutine hv */
430INLINE struct coro *
431SvSTATE_hv (SV *sv)
432{
433 MAGIC *mg = expect_true (SvMAGIC (sv)->mg_type == CORO_MAGIC_type_state)
434 ? SvMAGIC (sv)
435 : mg_find (sv, CORO_MAGIC_type_state);
436
437 return (struct coro *)mg->mg_ptr;
438}
439
440#define SvSTATE_current SvSTATE_hv (SvRV (coro_current))
443 441
444/* the next two functions merely cache the padlists */ 442/* the next two functions merely cache the padlists */
445static void 443static void
446get_padlist (pTHX_ CV *cv) 444get_padlist (pTHX_ CV *cv)
447{ 445{
… …
811 809
812 return orig_sigelem_set ? orig_sigelem_set (aTHX_ sv, mg) : 0; 810 return orig_sigelem_set ? orig_sigelem_set (aTHX_ sv, mg) : 0;
813} 811}
814 812
815static void 813static void
816prepare_nop (aTHX_ struct coro_transfer_args *ta) 814prepare_nop (pTHX_ struct coro_transfer_args *ta)
817{ 815{
818 /* kind of mega-hacky, but works */ 816 /* kind of mega-hacky, but works */
819 ta->next = ta->prev = (struct coro *)ta; 817 ta->next = ta->prev = (struct coro *)ta;
820} 818}
821 819
822static int 820static int
823slf_check_nop (aTHX) 821slf_check_nop (pTHX_ struct CoroSLF *frame)
824{ 822{
825 return 0; 823 return 0;
826} 824}
827 825
828static void 826static void
… …
929static int 927static int
930runops_trace (pTHX) 928runops_trace (pTHX)
931{ 929{
932 COP *oldcop = 0; 930 COP *oldcop = 0;
933 int oldcxix = -2; 931 int oldcxix = -2;
934 struct coro *coro = SvSTATE (coro_current); /* trace cctx is tied to specific coro */ 932 struct coro *coro = SvSTATE_current; /* trace cctx is tied to specific coro */
935 coro_cctx *cctx = coro->cctx; 933 coro_cctx *cctx = coro->cctx;
936 934
937 while ((PL_op = CALL_FPTR (PL_op->op_ppaddr) (aTHX))) 935 while ((PL_op = CALL_FPTR (PL_op->op_ppaddr) (aTHX)))
938 { 936 {
939 PERL_ASYNC_CHECK (); 937 PERL_ASYNC_CHECK ();
… …
1088 1086
1089/* the tail of transfer: execute stuff we can only do after a transfer */ 1087/* the tail of transfer: execute stuff we can only do after a transfer */
1090INLINE void 1088INLINE void
1091transfer_tail (pTHX) 1089transfer_tail (pTHX)
1092{ 1090{
1093 struct coro *next = (struct coro *)transfer_next;
1094 assert (!(transfer_next = 0)); /* just used for the side effect when asserts are enabled */
1095 assert (("FATAL: next coroutine was zero in transfer_tail (please report)", next));
1096
1097 free_coro_mortal (aTHX); 1091 free_coro_mortal (aTHX);
1098 UNLOCK;
1099
1100 if (expect_false (next->throw))
1101 {
1102 SV *exception = sv_2mortal (next->throw);
1103
1104 next->throw = 0;
1105 sv_setsv (ERRSV, exception);
1106 croak (0);
1107 }
1108} 1092}
1109 1093
1110/* 1094/*
1111 * this is a _very_ stripped down perl interpreter ;) 1095 * this is a _very_ stripped down perl interpreter ;)
1112 */ 1096 */
… …
1127 1111
1128 /* inject a fake subroutine call to cctx_init */ 1112 /* inject a fake subroutine call to cctx_init */
1129 cctx_prepare (aTHX_ (coro_cctx *)arg); 1113 cctx_prepare (aTHX_ (coro_cctx *)arg);
1130 1114
1131 /* cctx_run is the alternative tail of transfer() */ 1115 /* cctx_run is the alternative tail of transfer() */
1132 /* TODO: throwing an exception here might be deadly, VERIFY */
1133 transfer_tail (aTHX); 1116 transfer_tail (aTHX);
1134 1117
1135 /* somebody or something will hit me for both perl_run and PL_restartop */ 1118 /* somebody or something will hit me for both perl_run and PL_restartop */
1136 PL_restartop = PL_op; 1119 PL_restartop = PL_op;
1137 perl_run (PL_curinterp); 1120 perl_run (PL_curinterp);
… …
1320 dSTACKLEVEL; 1303 dSTACKLEVEL;
1321 1304
1322 /* sometimes transfer is only called to set idle_sp */ 1305 /* sometimes transfer is only called to set idle_sp */
1323 if (expect_false (!next)) 1306 if (expect_false (!next))
1324 { 1307 {
1325 ((coro_cctx *)prev)->idle_sp = stacklevel; 1308 ((coro_cctx *)prev)->idle_sp = (void *)stacklevel;
1326 assert (((coro_cctx *)prev)->idle_te = PL_top_env); /* just for the side-effect when asserts are enabled */ 1309 assert (((coro_cctx *)prev)->idle_te = PL_top_env); /* just for the side-effect when asserts are enabled */
1327 } 1310 }
1328 else if (expect_true (prev != next)) 1311 else if (expect_true (prev != next))
1329 { 1312 {
1330 coro_cctx *prev__cctx; 1313 coro_cctx *prev__cctx;
… …
1337 prev->flags |= CF_RUNNING; 1320 prev->flags |= CF_RUNNING;
1338 } 1321 }
1339 1322
1340 prev->flags &= ~CF_RUNNING; 1323 prev->flags &= ~CF_RUNNING;
1341 next->flags |= CF_RUNNING; 1324 next->flags |= CF_RUNNING;
1342
1343 LOCK;
1344 1325
1345 /* first get rid of the old state */ 1326 /* first get rid of the old state */
1346 save_perl (aTHX_ prev); 1327 save_perl (aTHX_ prev);
1347 1328
1348 if (expect_false (next->flags & CF_NEW)) 1329 if (expect_false (next->flags & CF_NEW))
… …
1357 1338
1358 prev__cctx = prev->cctx; 1339 prev__cctx = prev->cctx;
1359 1340
1360 /* possibly untie and reuse the cctx */ 1341 /* possibly untie and reuse the cctx */
1361 if (expect_true ( 1342 if (expect_true (
1362 prev__cctx->idle_sp == stacklevel 1343 prev__cctx->idle_sp == (void *)stacklevel
1363 && !(prev__cctx->flags & CC_TRACE) 1344 && !(prev__cctx->flags & CC_TRACE)
1364 && !force_cctx 1345 && !force_cctx
1365 )) 1346 ))
1366 { 1347 {
1367 /* I assume that stacklevel is a stronger indicator than PL_top_env changes */ 1348 /* I assume that stacklevel is a stronger indicator than PL_top_env changes */
… …
1381 ++next->usecount; 1362 ++next->usecount;
1382 1363
1383 if (expect_true (!next->cctx)) 1364 if (expect_true (!next->cctx))
1384 next->cctx = cctx_get (aTHX); 1365 next->cctx = cctx_get (aTHX);
1385 1366
1386 assert (("FATAL: transfer_next already nonzero in Coro (please report)", !transfer_next));
1387 transfer_next = next;
1388
1389 if (expect_false (prev__cctx != next->cctx)) 1367 if (expect_false (prev__cctx != next->cctx))
1390 { 1368 {
1391 prev__cctx->top_env = PL_top_env; 1369 prev__cctx->top_env = PL_top_env;
1392 PL_top_env = next->cctx->top_env; 1370 PL_top_env = next->cctx->top_env;
1393 coro_transfer (&prev__cctx->cctx, &next->cctx->cctx); 1371 coro_transfer (&prev__cctx->cctx, &next->cctx->cctx);
… …
1406coro_state_destroy (pTHX_ struct coro *coro) 1384coro_state_destroy (pTHX_ struct coro *coro)
1407{ 1385{
1408 if (coro->flags & CF_DESTROYED) 1386 if (coro->flags & CF_DESTROYED)
1409 return 0; 1387 return 0;
1410 1388
1389 if (coro->on_destroy)
1390 coro->on_destroy (aTHX_ coro);
1391
1411 coro->flags |= CF_DESTROYED; 1392 coro->flags |= CF_DESTROYED;
1412 1393
1413 if (coro->flags & CF_READY) 1394 if (coro->flags & CF_READY)
1414 { 1395 {
1415 /* reduce nready, as destroying a ready coro effectively unreadies it */ 1396 /* reduce nready, as destroying a ready coro effectively unreadies it */
1416 /* alternative: look through all ready queues and remove the coro */ 1397 /* alternative: look through all ready queues and remove the coro */
1417 LOCK;
1418 --coro_nready; 1398 --coro_nready;
1419 UNLOCK;
1420 } 1399 }
1421 else 1400 else
1422 coro->flags |= CF_READY; /* make sure it is NOT put into the readyqueue */ 1401 coro->flags |= CF_READY; /* make sure it is NOT put into the readyqueue */
1423 1402
1424 if (coro->mainstack && coro->mainstack != main_mainstack) 1403 if (coro->mainstack && coro->mainstack != main_mainstack)
… …
1502 TRANSFER (ta, 1); 1481 TRANSFER (ta, 1);
1503} 1482}
1504 1483
1505/** Coro ********************************************************************/ 1484/** Coro ********************************************************************/
1506 1485
1507static void 1486INLINE void
1508coro_enq (pTHX_ SV *coro_sv) 1487coro_enq (pTHX_ struct coro *coro)
1509{ 1488{
1510 av_push (coro_ready [SvSTATE (coro_sv)->prio - PRIO_MIN], coro_sv); 1489 av_push (coro_ready [coro->prio - PRIO_MIN], SvREFCNT_inc_NN (coro->hv));
1511} 1490}
1512 1491
1513static SV * 1492INLINE SV *
1514coro_deq (pTHX) 1493coro_deq (pTHX)
1515{ 1494{
1516 int prio; 1495 int prio;
1517 1496
1518 for (prio = PRIO_MAX - PRIO_MIN + 1; --prio >= 0; ) 1497 for (prio = PRIO_MAX - PRIO_MIN + 1; --prio >= 0; )
… …
1537 if (coro->flags & CF_READY) 1516 if (coro->flags & CF_READY)
1538 return 0; 1517 return 0;
1539 1518
1540 coro->flags |= CF_READY; 1519 coro->flags |= CF_READY;
1541 1520
1542 LOCK;
1543
1544 sv_hook = coro_nready ? 0 : coro_readyhook; 1521 sv_hook = coro_nready ? 0 : coro_readyhook;
1545 xs_hook = coro_nready ? 0 : coroapi.readyhook; 1522 xs_hook = coro_nready ? 0 : coroapi.readyhook;
1546 1523
1547 coro_enq (aTHX_ SvREFCNT_inc_NN (coro_sv)); 1524 coro_enq (aTHX_ coro);
1548 ++coro_nready; 1525 ++coro_nready;
1549 1526
1550 UNLOCK;
1551
1552 if (sv_hook) 1527 if (sv_hook)
1553 { 1528 {
1554 dSP; 1529 dSP;
1555 1530
1556 ENTER; 1531 ENTER;
… …
1582{ 1557{
1583 SV *prev_sv, *next_sv; 1558 SV *prev_sv, *next_sv;
1584 1559
1585 for (;;) 1560 for (;;)
1586 { 1561 {
1587 LOCK;
1588 next_sv = coro_deq (aTHX); 1562 next_sv = coro_deq (aTHX);
1589 1563
1590 /* nothing to schedule: call the idle handler */ 1564 /* nothing to schedule: call the idle handler */
1591 if (expect_false (!next_sv)) 1565 if (expect_false (!next_sv))
1592 { 1566 {
1593 dSP; 1567 dSP;
1594 UNLOCK;
1595 1568
1596 ENTER; 1569 ENTER;
1597 SAVETMPS; 1570 SAVETMPS;
1598 1571
1599 PUSHMARK (SP); 1572 PUSHMARK (SP);
… …
1604 FREETMPS; 1577 FREETMPS;
1605 LEAVE; 1578 LEAVE;
1606 continue; 1579 continue;
1607 } 1580 }
1608 1581
1609 ta->next = SvSTATE (next_sv); 1582 ta->next = SvSTATE_hv (next_sv);
1610 1583
1611 /* cannot transfer to destroyed coros, skip and look for next */ 1584 /* cannot transfer to destroyed coros, skip and look for next */
1612 if (expect_false (ta->next->flags & CF_DESTROYED)) 1585 if (expect_false (ta->next->flags & CF_DESTROYED))
1613 { 1586 {
1614 UNLOCK;
1615 SvREFCNT_dec (next_sv); 1587 SvREFCNT_dec (next_sv);
1616 /* coro_nready has already been taken care of by destroy */ 1588 /* coro_nready has already been taken care of by destroy */
1617 continue; 1589 continue;
1618 } 1590 }
1619 1591
1620 --coro_nready; 1592 --coro_nready;
1621 UNLOCK;
1622 break; 1593 break;
1623 } 1594 }
1624 1595
1625 /* free this only after the transfer */ 1596 /* free this only after the transfer */
1626 prev_sv = SvRV (coro_current); 1597 prev_sv = SvRV (coro_current);
1627 ta->prev = SvSTATE (prev_sv); 1598 ta->prev = SvSTATE_hv (prev_sv);
1628 TRANSFER_CHECK (*ta); 1599 TRANSFER_CHECK (*ta);
1629 assert (("FATAL: next coroutine isn't marked as ready in Coro (please report)", ta->next->flags & CF_READY)); 1600 assert (("FATAL: next coroutine isn't marked as ready in Coro (please report)", ta->next->flags & CF_READY));
1630 ta->next->flags &= ~CF_READY; 1601 ta->next->flags &= ~CF_READY;
1631 SvRV_set (coro_current, next_sv); 1602 SvRV_set (coro_current, next_sv);
1632 1603
1633 LOCK;
1634 free_coro_mortal (aTHX); 1604 free_coro_mortal (aTHX);
1635 coro_mortal = prev_sv; 1605 coro_mortal = prev_sv;
1636 UNLOCK;
1637} 1606}
1638 1607
1639INLINE void 1608INLINE void
1640prepare_cede (pTHX_ struct coro_transfer_args *ta) 1609prepare_cede (pTHX_ struct coro_transfer_args *ta)
1641{ 1610{
… …
1719 PL_runops = RUNOPS_DEFAULT; 1688 PL_runops = RUNOPS_DEFAULT;
1720 else 1689 else
1721 coro->slot->runops = RUNOPS_DEFAULT; 1690 coro->slot->runops = RUNOPS_DEFAULT;
1722 } 1691 }
1723} 1692}
1724
1725#if 0
1726static int
1727coro_gensub_free (pTHX_ SV *sv, MAGIC *mg)
1728{
1729 AV *padlist;
1730 AV *av = (AV *)mg->mg_obj;
1731
1732 abort ();
1733
1734 return 0;
1735}
1736
1737static MGVTBL coro_gensub_vtbl = {
1738 0, 0, 0, 0,
1739 coro_gensub_free
1740};
1741#endif
1742 1693
1743/*****************************************************************************/ 1694/*****************************************************************************/
1744/* PerlIO::cede */ 1695/* PerlIO::cede */
1745 1696
1746typedef struct 1697typedef struct
… …
1848{ 1799{
1849 prepare_set_stacklevel (ta, (struct coro_cctx *)slf_frame.data); 1800 prepare_set_stacklevel (ta, (struct coro_cctx *)slf_frame.data);
1850} 1801}
1851 1802
1852static void 1803static void
1853slf_init_set_stacklevel (pTHX_ struct CoroSLF *frame, SV **arg, int items) 1804slf_init_set_stacklevel (pTHX_ struct CoroSLF *frame, CV *cv, SV **arg, int items)
1854{ 1805{
1855 assert (("FATAL: set_stacklevel needs the coro cctx as sole argument", items == 1)); 1806 assert (("FATAL: set_stacklevel needs the coro cctx as sole argument", items == 1));
1856 1807
1857 frame->prepare = slf_prepare_set_stacklevel; 1808 frame->prepare = slf_prepare_set_stacklevel;
1858 frame->check = slf_check_nop; 1809 frame->check = slf_check_nop;
… …
1862static void 1813static void
1863slf_prepare_transfer (pTHX_ struct coro_transfer_args *ta) 1814slf_prepare_transfer (pTHX_ struct coro_transfer_args *ta)
1864{ 1815{
1865 SV **arg = (SV **)slf_frame.data; 1816 SV **arg = (SV **)slf_frame.data;
1866 1817
1867 prepare_transfer (ta, arg [0], arg [1]); 1818 prepare_transfer (aTHX_ ta, arg [0], arg [1]);
1868}
1869 1819
1820 /* if the destination has ->throw set, then copy it */
1821 /* into the current coro's throw slot, so it will be raised */
1822 /* after the schedule */
1823 if (expect_false (ta->next->throw))
1824 {
1825 struct coro *coro = SvSTATE_current;
1826 SvREFCNT_dec (coro->throw);
1827 coro->throw = ta->next->throw;
1828 ta->next->throw = 0;
1829 }
1830}
1831
1870static void 1832static void
1871slf_init_transfer (pTHX_ struct CoroSLF *frame, SV **arg, int items) 1833slf_init_transfer (pTHX_ struct CoroSLF *frame, CV *cv, SV **arg, int items)
1872{ 1834{
1873 if (items != 2) 1835 if (items != 2)
1874 croak ("Coro::State::transfer (prev, next) expects two arguments, not %d,", items); 1836 croak ("Coro::State::transfer (prev, next) expects two arguments, not %d,", items);
1875 1837
1876 frame->prepare = slf_prepare_transfer; 1838 frame->prepare = slf_prepare_transfer;
1877 frame->check = slf_check_nop; 1839 frame->check = slf_check_nop;
1878 frame->data = (void *)arg; /* let's hope it will stay valid */ 1840 frame->data = (void *)arg; /* let's hope it will stay valid */
1879} 1841}
1880 1842
1881static void 1843static void
1882slf_init_schedule (pTHX_ struct CoroSLF *frame, SV **arg, int items) 1844slf_init_schedule (pTHX_ struct CoroSLF *frame, CV *cv, SV **arg, int items)
1883{ 1845{
1884 frame->prepare = prepare_schedule; 1846 frame->prepare = prepare_schedule;
1885 frame->check = slf_check_nop; 1847 frame->check = slf_check_nop;
1886} 1848}
1887 1849
1888static void 1850static void
1889slf_init_cede (pTHX_ struct CoroSLF *frame, SV **arg, int items) 1851slf_init_cede (pTHX_ struct CoroSLF *frame, CV *cv, SV **arg, int items)
1890{ 1852{
1891 frame->prepare = prepare_cede; 1853 frame->prepare = prepare_cede;
1892 frame->check = slf_check_nop; 1854 frame->check = slf_check_nop;
1893} 1855}
1894 1856
1895static void 1857static void
1896slf_init_cede_notself (pTHX_ struct CoroSLF *frame, SV **arg, int items) 1858slf_init_cede_notself (pTHX_ struct CoroSLF *frame, CV *cv, SV **arg, int items)
1897{ 1859{
1898 frame->prepare = prepare_cede_notself; 1860 frame->prepare = prepare_cede_notself;
1899 frame->check = slf_check_nop; 1861 frame->check = slf_check_nop;
1900} 1862}
1901 1863
… …
1927 /* do a quick consistency check on the "function" object, and if it isn't */ 1889 /* do a quick consistency check on the "function" object, and if it isn't */
1928 /* for us, divert to the real entersub */ 1890 /* for us, divert to the real entersub */
1929 if (SvTYPE (gv) != SVt_PVGV || !(CvFLAGS (GvCV (gv)) & CVf_SLF)) 1891 if (SvTYPE (gv) != SVt_PVGV || !(CvFLAGS (GvCV (gv)) & CVf_SLF))
1930 return PL_ppaddr[OP_ENTERSUB](aTHX); 1892 return PL_ppaddr[OP_ENTERSUB](aTHX);
1931 1893
1932 /* pop args */
1933 SP = PL_stack_base + POPMARK;
1934
1935 if (!(PL_op->op_flags & OPf_STACKED)) 1894 if (!(PL_op->op_flags & OPf_STACKED))
1936 { 1895 {
1937 /* ampersand-form of call, use @_ instead of stack */ 1896 /* ampersand-form of call, use @_ instead of stack */
1938 AV *av = GvAV (PL_defgv); 1897 AV *av = GvAV (PL_defgv);
1939 arg = AvARRAY (av); 1898 arg = AvARRAY (av);
1940 items = AvFILLp (av) + 1; 1899 items = AvFILLp (av) + 1;
1941 } 1900 }
1942 1901
1943 PUTBACK; 1902 PUTBACK;
1944 1903
1904 /* now call the init function, which needs to set up slf_frame */
1945 ((coro_slf_cb)CvXSUBANY (GvCV (gv)).any_ptr) (aTHX_ &slf_frame, arg, items); 1905 ((coro_slf_cb)CvXSUBANY (GvCV (gv)).any_ptr)
1946 } 1906 (aTHX_ &slf_frame, GvCV (gv), arg, items);
1947 1907
1948 /* now interpret the slf_frame */ 1908 /* pop args */
1909 SP = PL_stack_base + POPMARK;
1910
1911 PUTBACK;
1912 }
1913
1914 /* now that we have a slf_frame, interpret it! */
1949 /* we use a callback system not to make the code needlessly */ 1915 /* we use a callback system not to make the code needlessly */
1950 /* complicated, but so we can run multiple perl coros from one cctx */ 1916 /* complicated, but so we can run multiple perl coros from one cctx */
1951 1917
1952 do 1918 do
1953 { 1919 {
… …
1963 { 1929 {
1964 dSP; 1930 dSP;
1965 SV **bot = PL_stack_base + checkmark; 1931 SV **bot = PL_stack_base + checkmark;
1966 int gimme = GIMME_V; 1932 int gimme = GIMME_V;
1967 1933
1968 slf_frame.prepare = 0; /* signal pp_slf that we need a new frame */ 1934 slf_frame.prepare = 0; /* invalidate the frame, so it gets initialised again next time */
1969 1935
1970 /* make sure we put something on the stack in scalar context */ 1936 /* make sure we put something on the stack in scalar context */
1971 if (gimme == G_SCALAR) 1937 if (gimme == G_SCALAR)
1972 { 1938 {
1973 if (sp == bot) 1939 if (sp == bot)
… …
1977 } 1943 }
1978 1944
1979 PUTBACK; 1945 PUTBACK;
1980 } 1946 }
1981 1947
1948 {
1949 struct coro *coro = SvSTATE_current;
1950
1951 if (expect_false (coro->throw))
1952 {
1953 SV *exception = sv_2mortal (coro->throw);
1954
1955 coro->throw = 0;
1956 sv_setsv (ERRSV, exception);
1957 croak (0);
1958 }
1959 }
1960
1982 return NORMAL; 1961 return NORMAL;
1983} 1962}
1984 1963
1985static void 1964static void
1986api_execute_slf (pTHX_ CV *cv, coro_slf_cb init_cb, SV **arg, int items) 1965api_execute_slf (pTHX_ CV *cv, coro_slf_cb init_cb, SV **arg, int items)
… …
1990 if (PL_op->op_ppaddr != PL_ppaddr [OP_ENTERSUB] 1969 if (PL_op->op_ppaddr != PL_ppaddr [OP_ENTERSUB]
1991 && PL_op->op_ppaddr != pp_slf) 1970 && PL_op->op_ppaddr != pp_slf)
1992 croak ("FATAL: Coro SLF calls can only be made normally, not via goto or any other means, caught"); 1971 croak ("FATAL: Coro SLF calls can only be made normally, not via goto or any other means, caught");
1993 1972
1994 if (items > 3) 1973 if (items > 3)
1995 croak ("Coro only supports up to three arguments to SLF functions currently, caught"); 1974 croak ("Coro only supports up to three arguments to SLF functions currently (not %d), caught", items);
1996 1975
1997 CvFLAGS (cv) |= CVf_SLF; 1976 CvFLAGS (cv) |= CVf_SLF;
1998 CvXSUBANY (cv).any_ptr = (void *)init_cb; 1977 CvXSUBANY (cv).any_ptr = (void *)init_cb;
1999 slf_cv = cv; 1978 slf_cv = cv;
2000 1979
2001 /* we patch the op, and then re-run the whole call */ 1980 /* we patch the op, and then re-run the whole call */
2002 /* we have to put the same argument on the stack for this to work */ 1981 /* we have to put the same argument on the stack for this to work */
2003 /* and this will be done by pp_restore */ 1982 /* and this will be done by pp_restore */
2004 slf_restore.op_next = (OP *)&slf_restore; 1983 slf_restore.op_next = (OP *)&slf_restore;
2005 slf_restore.op_type = OP_NULL; 1984 slf_restore.op_type = OP_CUSTOM;
2006 slf_restore.op_ppaddr = pp_restore; 1985 slf_restore.op_ppaddr = pp_restore;
2007 slf_restore.op_first = PL_op; 1986 slf_restore.op_first = PL_op;
2008 1987
2009 slf_arg0 = items > 0 ? SvREFCNT_inc (arg [0]) : 0; 1988 slf_arg0 = items > 0 ? SvREFCNT_inc (arg [0]) : 0;
2010 slf_arg1 = items > 1 ? SvREFCNT_inc (arg [1]) : 0; 1989 slf_arg1 = items > 1 ? SvREFCNT_inc (arg [1]) : 0;
… …
2013 PL_op->op_ppaddr = pp_slf; 1992 PL_op->op_ppaddr = pp_slf;
2014 1993
2015 PL_op = (OP *)&slf_restore; 1994 PL_op = (OP *)&slf_restore;
2016} 1995}
2017 1996
1997/*****************************************************************************/
1998
1999static void
2000coro_semaphore_adjust (pTHX_ AV *av, IV adjust)
2001{
2002 SV *count_sv = AvARRAY (av)[0];
2003 IV count = SvIVX (count_sv);
2004
2005 count += adjust;
2006 SvIVX (count_sv) = count;
2007
2008 /* now wake up as many waiters as are expected to lock */
2009 while (count > 0 && AvFILLp (av) > 0)
2010 {
2011 SV *cb;
2012
2013 /* swap first two elements so we can shift a waiter */
2014 AvARRAY (av)[0] = AvARRAY (av)[1];
2015 AvARRAY (av)[1] = count_sv;
2016 cb = av_shift (av);
2017
2018 if (SvOBJECT (cb))
2019 api_ready (aTHX_ cb);
2020 else
2021 croak ("callbacks not yet supported");
2022
2023 SvREFCNT_dec (cb);
2024
2025 --count;
2026 }
2027}
2028
2029static void
2030coro_semaphore_on_destroy (pTHX_ struct coro *coro)
2031{
2032 /* call $sem->adjust (0) to possibly wake up some other waiters */
2033 coro_semaphore_adjust (aTHX_ (AV *)coro->slf_frame.data, 0);
2034}
2035
2036static int
2037slf_check_semaphore_down (pTHX_ struct CoroSLF *frame)
2038{
2039 AV *av = (AV *)frame->data;
2040 SV *count_sv = AvARRAY (av)[0];
2041
2042 if (SvIVX (count_sv) > 0)
2043 {
2044 SvSTATE_current->on_destroy = 0;
2045 SvIVX (count_sv) = SvIVX (count_sv) - 1;
2046 return 0;
2047 }
2048 else
2049 {
2050 int i;
2051 /* if we were woken up but can't down, we look through the whole */
2052 /* waiters list and only add us if we aren't in there already */
2053 /* this avoids some degenerate memory usage cases */
2054
2055 for (i = 1; i <= AvFILLp (av); ++i)
2056 if (AvARRAY (av)[i] == SvRV (coro_current))
2057 return 1;
2058
2059 av_push (av, SvREFCNT_inc (SvRV (coro_current)));
2060 return 1;
2061 }
2062}
2063
2064static void
2065slf_init_semaphore_down (pTHX_ struct CoroSLF *frame, CV *cv, SV **arg, int items)
2066{
2067 AV *av = (AV *)SvRV (arg [0]);
2068
2069 if (SvIVX (AvARRAY (av)[0]) > 0)
2070 {
2071 frame->data = (void *)av;
2072 frame->prepare = prepare_nop;
2073 SvSTATE_current->on_destroy = coro_semaphore_on_destroy;
2074 }
2075 else
2076 {
2077 av_push (av, SvREFCNT_inc (SvRV (coro_current)));
2078
2079 frame->data = (void *)sv_2mortal (SvREFCNT_inc ((SV *)av));
2080 frame->prepare = prepare_schedule;
2081
2082 /* to avoid race conditions when a woken-up coro gets terminated */
2083 /* we arrange for a temporary on_destroy that calls adjust (0) */
2084 assert (!SvSTATE_current->on_destroy);//D
2085 SvSTATE_current->on_destroy = coro_semaphore_on_destroy;
2086 }
2087
2088 frame->check = slf_check_semaphore_down;
2089
2090}
2091
2092/*****************************************************************************/
2093
2094#define GENSUB_ARG CvXSUBANY (cv).any_ptr
2095
2096/* create a closure from XS, returns a code reference */
2097/* the arg can be accessed via GENSUB_ARG from the callback */
2098/* the callback must use dXSARGS/XSRETURN */
2099static SV *
2100gensub (pTHX_ void (*xsub)(pTHX_ CV *), void *arg)
2101{
2102 CV *cv = (CV *)NEWSV (0, 0);
2103
2104 sv_upgrade ((SV *)cv, SVt_PVCV);
2105
2106 CvANON_on (cv);
2107 CvISXSUB_on (cv);
2108 CvXSUB (cv) = xsub;
2109 GENSUB_ARG = arg;
2110
2111 return newRV_noinc ((SV *)cv);
2112}
2113
2114/*****************************************************************************/
2115
2018MODULE = Coro::State PACKAGE = Coro::State PREFIX = api_ 2116MODULE = Coro::State PACKAGE = Coro::State PREFIX = api_
2019 2117
2020PROTOTYPES: DISABLE 2118PROTOTYPES: DISABLE
2021 2119
2022BOOT: 2120BOOT:
2023{ 2121{
2024#ifdef USE_ITHREADS 2122#ifdef USE_ITHREADS
2025 MUTEX_INIT (&coro_lock);
2026# if CORO_PTHREAD 2123# if CORO_PTHREAD
2027 coro_thx = PERL_GET_CONTEXT; 2124 coro_thx = PERL_GET_CONTEXT;
2028# endif 2125# endif
2029#endif 2126#endif
2030 BOOT_PAGESIZE; 2127 BOOT_PAGESIZE;
… …
2050 main_mainstack = PL_mainstack; 2147 main_mainstack = PL_mainstack;
2051 main_top_env = PL_top_env; 2148 main_top_env = PL_top_env;
2052 2149
2053 while (main_top_env->je_prev) 2150 while (main_top_env->je_prev)
2054 main_top_env = main_top_env->je_prev; 2151 main_top_env = main_top_env->je_prev;
2152
2153 {
2154 SV *slf = sv_2mortal (newSViv (PTR2IV (pp_slf)));
2155
2156 if (!PL_custom_op_names) PL_custom_op_names = newHV ();
2157 hv_store_ent (PL_custom_op_names, slf,
2158 newSVpv ("coro_slf", 0), 0);
2159
2160 if (!PL_custom_op_descs) PL_custom_op_descs = newHV ();
2161 hv_store_ent (PL_custom_op_descs, slf,
2162 newSVpv ("coro schedule like function", 0), 0);
2163 }
2055 2164
2056 coroapi.ver = CORO_API_VERSION; 2165 coroapi.ver = CORO_API_VERSION;
2057 coroapi.rev = CORO_API_REVISION; 2166 coroapi.rev = CORO_API_REVISION;
2058 2167
2059 coroapi.transfer = api_transfer; 2168 coroapi.transfer = api_transfer;
… …
2111 CODE: 2220 CODE:
2112 api_execute_slf (aTHX_ cv, slf_init_set_stacklevel, &ST (0), items); 2221 api_execute_slf (aTHX_ cv, slf_init_set_stacklevel, &ST (0), items);
2113 2222
2114void 2223void
2115transfer (...) 2224transfer (...)
2225 PROTOTYPE: $$
2116 CODE: 2226 CODE:
2117 api_execute_slf (aTHX_ cv, slf_init_transfer, &ST (0), items); 2227 api_execute_slf (aTHX_ cv, slf_init_transfer, &ST (0), items);
2118 2228
2119bool 2229bool
2120_destroy (SV *coro_sv) 2230_destroy (SV *coro_sv)
… …
2129 CODE: 2239 CODE:
2130 _exit (code); 2240 _exit (code);
2131 2241
2132int 2242int
2133cctx_stacksize (int new_stacksize = 0) 2243cctx_stacksize (int new_stacksize = 0)
2244 PROTOTYPE: ;$
2134 CODE: 2245 CODE:
2135 RETVAL = cctx_stacksize; 2246 RETVAL = cctx_stacksize;
2136 if (new_stacksize) 2247 if (new_stacksize)
2137 { 2248 {
2138 cctx_stacksize = new_stacksize; 2249 cctx_stacksize = new_stacksize;
… …
2141 OUTPUT: 2252 OUTPUT:
2142 RETVAL 2253 RETVAL
2143 2254
2144int 2255int
2145cctx_max_idle (int max_idle = 0) 2256cctx_max_idle (int max_idle = 0)
2257 PROTOTYPE: ;$
2146 CODE: 2258 CODE:
2147 RETVAL = cctx_max_idle; 2259 RETVAL = cctx_max_idle;
2148 if (max_idle > 1) 2260 if (max_idle > 1)
2149 cctx_max_idle = max_idle; 2261 cctx_max_idle = max_idle;
2150 OUTPUT: 2262 OUTPUT:
2151 RETVAL 2263 RETVAL
2152 2264
2153int 2265int
2154cctx_count () 2266cctx_count ()
2267 PROTOTYPE:
2155 CODE: 2268 CODE:
2156 RETVAL = cctx_count; 2269 RETVAL = cctx_count;
2157 OUTPUT: 2270 OUTPUT:
2158 RETVAL 2271 RETVAL
2159 2272
2160int 2273int
2161cctx_idle () 2274cctx_idle ()
2275 PROTOTYPE:
2162 CODE: 2276 CODE:
2163 RETVAL = cctx_idle; 2277 RETVAL = cctx_idle;
2164 OUTPUT: 2278 OUTPUT:
2165 RETVAL 2279 RETVAL
2166 2280
2167void 2281void
2168list () 2282list ()
2283 PROTOTYPE:
2169 PPCODE: 2284 PPCODE:
2170{ 2285{
2171 struct coro *coro; 2286 struct coro *coro;
2172 for (coro = coro_first; coro; coro = coro->next) 2287 for (coro = coro_first; coro; coro = coro->next)
2173 if (coro->hv) 2288 if (coro->hv)
… …
2240 SvREFCNT_dec (self->throw); 2355 SvREFCNT_dec (self->throw);
2241 self->throw = SvOK (throw) ? newSVsv (throw) : 0; 2356 self->throw = SvOK (throw) ? newSVsv (throw) : 0;
2242 2357
2243void 2358void
2244api_trace (SV *coro, int flags = CC_TRACE | CC_TRACE_SUB) 2359api_trace (SV *coro, int flags = CC_TRACE | CC_TRACE_SUB)
2360 PROTOTYPE: $;$
2245 C_ARGS: aTHX_ coro, flags 2361 C_ARGS: aTHX_ coro, flags
2246 2362
2247SV * 2363SV *
2248has_cctx (Coro::State coro) 2364has_cctx (Coro::State coro)
2249 PROTOTYPE: $ 2365 PROTOTYPE: $
… …
2274 OUTPUT: 2390 OUTPUT:
2275 RETVAL 2391 RETVAL
2276 2392
2277void 2393void
2278force_cctx () 2394force_cctx ()
2395 PROTOTYPE:
2279 CODE: 2396 CODE:
2280 struct coro *coro = SvSTATE (coro_current);
2281 coro->cctx->idle_sp = 0; 2397 SvSTATE_current->cctx->idle_sp = 0;
2282 2398
2283void 2399void
2284swap_defsv (Coro::State self) 2400swap_defsv (Coro::State self)
2285 PROTOTYPE: $ 2401 PROTOTYPE: $
2286 ALIAS: 2402 ALIAS:
… …
2339} 2455}
2340 2456
2341void 2457void
2342schedule (...) 2458schedule (...)
2343 CODE: 2459 CODE:
2344 api_execute_slf (aTHX_ cv, slf_init_schedule, &ST (0), items); 2460 api_execute_slf (aTHX_ cv, slf_init_schedule, &ST (0), 0);
2345 2461
2346void 2462void
2347cede (...) 2463cede (...)
2348 CODE: 2464 CODE:
2349 api_execute_slf (aTHX_ cv, slf_init_cede, &ST (0), items); 2465 api_execute_slf (aTHX_ cv, slf_init_cede, &ST (0), 0);
2350 2466
2351void 2467void
2352cede_notself (...) 2468cede_notself (...)
2353 CODE: 2469 CODE:
2354 api_execute_slf (aTHX_ cv, slf_init_cede_notself, &ST (0), items); 2470 api_execute_slf (aTHX_ cv, slf_init_cede_notself, &ST (0), 0);
2355 2471
2356void 2472void
2357_set_current (SV *current) 2473_set_current (SV *current)
2358 PROTOTYPE: $ 2474 PROTOTYPE: $
2359 CODE: 2475 CODE:
… …
2362 2478
2363void 2479void
2364_set_readyhook (SV *hook) 2480_set_readyhook (SV *hook)
2365 PROTOTYPE: $ 2481 PROTOTYPE: $
2366 CODE: 2482 CODE:
2367 LOCK;
2368 SvREFCNT_dec (coro_readyhook); 2483 SvREFCNT_dec (coro_readyhook);
2369 coro_readyhook = SvOK (hook) ? newSVsv (hook) : 0; 2484 coro_readyhook = SvOK (hook) ? newSVsv (hook) : 0;
2370 UNLOCK;
2371 2485
2372int 2486int
2373prio (Coro::State coro, int newprio = 0) 2487prio (Coro::State coro, int newprio = 0)
2488 PROTOTYPE: $;$
2374 ALIAS: 2489 ALIAS:
2375 nice = 1 2490 nice = 1
2376 CODE: 2491 CODE:
2377{ 2492{
2378 RETVAL = coro->prio; 2493 RETVAL = coro->prio;
… …
2410# for async_pool speedup 2525# for async_pool speedup
2411void 2526void
2412_pool_1 (SV *cb) 2527_pool_1 (SV *cb)
2413 CODE: 2528 CODE:
2414{ 2529{
2415 struct coro *coro = SvSTATE (coro_current);
2416 HV *hv = (HV *)SvRV (coro_current); 2530 HV *hv = (HV *)SvRV (coro_current);
2531 struct coro *coro = SvSTATE_hv ((SV *)hv);
2417 AV *defav = GvAV (PL_defgv); 2532 AV *defav = GvAV (PL_defgv);
2418 SV *invoke = hv_delete (hv, "_invoke", sizeof ("_invoke") - 1, 0); 2533 SV *invoke = hv_delete (hv, "_invoke", sizeof ("_invoke") - 1, 0);
2419 AV *invoke_av; 2534 AV *invoke_av;
2420 int i, len; 2535 int i, len;
2421 2536
… …
2442 { 2557 {
2443 av_fill (defav, len - 1); 2558 av_fill (defav, len - 1);
2444 for (i = 0; i < len; ++i) 2559 for (i = 0; i < len; ++i)
2445 av_store (defav, i, SvREFCNT_inc_NN (AvARRAY (invoke_av)[i + 1])); 2560 av_store (defav, i, SvREFCNT_inc_NN (AvARRAY (invoke_av)[i + 1]));
2446 } 2561 }
2447
2448 SvREFCNT_dec (invoke);
2449} 2562}
2450 2563
2451void 2564void
2452_pool_2 (SV *cb) 2565_pool_2 (SV *cb)
2453 CODE: 2566 CODE:
2454{ 2567{
2455 struct coro *coro = SvSTATE (coro_current); 2568 struct coro *coro = SvSTATE_current;
2456 2569
2457 sv_setsv (cb, &PL_sv_undef); 2570 sv_setsv (cb, &PL_sv_undef);
2458 2571
2459 SvREFCNT_dec ((SV *)PL_defoutgv); PL_defoutgv = (GV *)coro->saved_deffh; 2572 SvREFCNT_dec ((SV *)PL_defoutgv); PL_defoutgv = (GV *)coro->saved_deffh;
2460 coro->saved_deffh = 0; 2573 coro->saved_deffh = 0;
… …
2478 api_trace (aTHX_ coro_current, 0); 2591 api_trace (aTHX_ coro_current, 0);
2479 2592
2480 av_push (av_async_pool, newSVsv (coro_current)); 2593 av_push (av_async_pool, newSVsv (coro_current));
2481} 2594}
2482 2595
2483#if 0
2484
2485void
2486_generator_call (...)
2487 PROTOTYPE: @
2488 PPCODE:
2489 fprintf (stderr, "call %p\n", CvXSUBANY(cv).any_ptr);
2490 xxxx
2491 abort ();
2492
2493SV *
2494gensub (SV *sub, ...)
2495 PROTOTYPE: &;@
2496 CODE:
2497{
2498 struct coro *coro;
2499 MAGIC *mg;
2500 CV *xcv;
2501 CV *ncv = (CV *)newSV_type (SVt_PVCV);
2502 int i;
2503
2504 CvGV (ncv) = CvGV (cv);
2505 CvFILE (ncv) = CvFILE (cv);
2506
2507 Newz (0, coro, 1, struct coro);
2508 coro->args = newAV ();
2509 coro->flags = CF_NEW;
2510
2511 av_extend (coro->args, items - 1);
2512 for (i = 1; i < items; i++)
2513 av_push (coro->args, newSVsv (ST (i)));
2514
2515 CvISXSUB_on (ncv);
2516 CvXSUBANY (ncv).any_ptr = (void *)coro;
2517
2518 xcv = GvCV (gv_fetchpv ("Coro::_generator_call", 0, SVt_PVCV));
2519
2520 CvXSUB (ncv) = CvXSUB (xcv);
2521 CvANON_on (ncv);
2522
2523 mg = sv_magicext ((SV *)ncv, 0, CORO_MAGIC_type_state, &coro_gensub_vtbl, (char *)coro, 0);
2524 RETVAL = newRV_noinc ((SV *)ncv);
2525}
2526 OUTPUT:
2527 RETVAL
2528
2529#endif
2530
2531 2596
2532MODULE = Coro::State PACKAGE = Coro::AIO 2597MODULE = Coro::State PACKAGE = Coro::AIO
2533 2598
2534void 2599void
2535_get_state (SV *self) 2600_get_state (SV *self)
2601 PROTOTYPE: $
2536 PPCODE: 2602 PPCODE:
2537{ 2603{
2538 AV *defav = GvAV (PL_defgv); 2604 AV *defav = GvAV (PL_defgv);
2539 AV *av = newAV (); 2605 AV *av = newAV ();
2540 int i; 2606 int i;
… …
2583MODULE = Coro::State PACKAGE = Coro::AnyEvent 2649MODULE = Coro::State PACKAGE = Coro::AnyEvent
2584 2650
2585BOOT: 2651BOOT:
2586 sv_activity = coro_get_sv (aTHX_ "Coro::AnyEvent::ACTIVITY", TRUE); 2652 sv_activity = coro_get_sv (aTHX_ "Coro::AnyEvent::ACTIVITY", TRUE);
2587 2653
2588SV * 2654void
2589_schedule (...) 2655_schedule (...)
2590 PROTOTYPE: @
2591 CODE: 2656 CODE:
2592{ 2657{
2593 static int incede; 2658 static int incede;
2594 2659
2595 api_cede_notself (aTHX); 2660 api_cede_notself (aTHX);
… …
2614MODULE = Coro::State PACKAGE = PerlIO::cede 2679MODULE = Coro::State PACKAGE = PerlIO::cede
2615 2680
2616BOOT: 2681BOOT:
2617 PerlIO_define_layer (aTHX_ &PerlIO_cede); 2682 PerlIO_define_layer (aTHX_ &PerlIO_cede);
2618 2683
2684MODULE = Coro::State PACKAGE = Coro::Semaphore
2685
2686SV *
2687new (SV *klass, SV *count_ = 0)
2688 CODE:
2689{
2690 /* a semaphore contains a counter IV in $sem->[0] and any waiters after that */
2691 AV *av = newAV ();
2692 av_push (av, newSViv (count_ && SvOK (count_) ? SvIV (count_) : 1));
2693 RETVAL = sv_bless (newRV_noinc ((SV *)av), GvSTASH (CvGV (cv)));
2694}
2695 OUTPUT:
2696 RETVAL
2697
2698SV *
2699count (SV *self)
2700 CODE:
2701 RETVAL = newSVsv (AvARRAY ((AV *)SvRV (self))[0]);
2702 OUTPUT:
2703 RETVAL
2704
2705void
2706up (SV *self, int adjust = 1)
2707 ALIAS:
2708 adjust = 1
2709 CODE:
2710 coro_semaphore_adjust (aTHX_ (AV *)SvRV (self), ix ? adjust : 1);
2711
2712void
2713down (SV *self)
2714 CODE:
2715 api_execute_slf (aTHX_ cv, slf_init_semaphore_down, &ST (0), 1);
2716
2717void
2718try (SV *self)
2719 PPCODE:
2720{
2721 AV *av = (AV *)SvRV (self);
2722 SV *count_sv = AvARRAY (av)[0];
2723 IV count = SvIVX (count_sv);
2724
2725 if (count > 0)
2726 {
2727 --count;
2728 SvIVX (count_sv) = count;
2729 XSRETURN_YES;
2730 }
2731 else
2732 XSRETURN_NO;
2733}
2734
2735void
2736waiters (SV *self)
2737 CODE:
2738{
2739 AV *av = (AV *)SvRV (self);
2740
2741 if (GIMME_V == G_SCALAR)
2742 XPUSHs (sv_2mortal (newSVsv (AvARRAY (av)[0])));
2743 else
2744 {
2745 int i;
2746 EXTEND (SP, AvFILLp (av) + 1 - 1);
2747 for (i = 1; i <= AvFILLp (av); ++i)
2748 PUSHs (newSVsv (AvARRAY (av)[i]));
2749 }
2750}
2751

Diff Legend

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