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.202 by root, Mon Oct 8 02:50:23 2007 UTC vs.
Revision 1.209 by root, Wed Oct 10 02:58:17 2007 UTC

… …
10#include "patchlevel.h" 10#include "patchlevel.h"
11 11
12#include <stdio.h> 12#include <stdio.h>
13#include <errno.h> 13#include <errno.h>
14#include <assert.h> 14#include <assert.h>
15#include <inttypes.h> /* portable stdint.h */
15 16
16#ifdef HAVE_MMAP 17#ifdef HAVE_MMAP
17# include <unistd.h> 18# include <unistd.h>
18# include <sys/mman.h> 19# include <sys/mman.h>
19# ifndef MAP_ANONYMOUS 20# ifndef MAP_ANONYMOUS
… …
160/* async_pool helper stuff */ 161/* async_pool helper stuff */
161static SV *sv_pool_rss; 162static SV *sv_pool_rss;
162static SV *sv_pool_size; 163static SV *sv_pool_size;
163static AV *av_async_pool; 164static AV *av_async_pool;
164 165
165static struct coro_cctx *cctx_first; 166static struct coro_cctx *cctx_first[3]; /* index by GIMME_V type, void, scalar, array */
166static int cctx_count, cctx_idle; 167static int cctx_count, cctx_idle[3];
167 168
168enum { 169enum {
169 CC_MAPPED = 0x01, 170 CC_MAPPED = 0x01,
170 CC_NOREUSE = 0x02, /* throw this away after tracing */ 171 CC_NOREUSE = 0x02, /* throw this away after tracing */
171 CC_TRACE = 0x04, 172 CC_TRACE = 0x04,
… …
216 217
217/* this is a structure representing a perl-level coroutine */ 218/* this is a structure representing a perl-level coroutine */
218struct coro { 219struct coro {
219 /* the c coroutine allocated to this perl coroutine, if any */ 220 /* the c coroutine allocated to this perl coroutine, if any */
220 coro_cctx *cctx; 221 coro_cctx *cctx;
222 int gimme;
221 223
222 /* process data */ 224 /* process data */
223 AV *mainstack; 225 AV *mainstack;
224 perl_slots *slot; /* basically the saved sp */ 226 perl_slots *slot; /* basically the saved sp */
225 227
226 /* data associated with this coroutine (initial args) */ 228 AV *args; /* data associated with this coroutine (initial args) */
227 AV *args; 229 int refcnt; /* coroutines are refcounted, yes */
228 int refcnt;
229 int flags; /* CF_ flags */ 230 int flags; /* CF_ flags */
231 HV *hv; /* the perl hash associated with this coro, if any */
230 232
231 /* statistics */ 233 /* statistics */
232 int usecount; /* number of transfers to this coro */ 234 int usecount; /* number of transfers to this coro */
233 235
234 /* coro process data */ 236 /* coro process data */
235 int prio; 237 int prio;
236 SV *throw; 238 SV *throw; /* exception to be thrown */
237 239
238 /* async_pool */ 240 /* async_pool */
239 SV *saved_deffh; 241 SV *saved_deffh;
240 242
241 /* linked list */ 243 /* linked list */
242 struct coro *next, *prev; 244 struct coro *next, *prev;
243 HV *hv; /* the perl hash associated with this coro, if any */
244}; 245};
245 246
246typedef struct coro *Coro__State; 247typedef struct coro *Coro__State;
247typedef struct coro *Coro__State_or_hashref; 248typedef struct coro *Coro__State_or_hashref;
248 249
… …
557 * allocate various perl stacks. This is an exact copy 558 * allocate various perl stacks. This is an exact copy
558 * of perl.c:init_stacks, except that it uses less memory 559 * of perl.c:init_stacks, except that it uses less memory
559 * on the (sometimes correct) assumption that coroutines do 560 * on the (sometimes correct) assumption that coroutines do
560 * not usually need a lot of stackspace. 561 * not usually need a lot of stackspace.
561 */ 562 */
562#if 1 563#if CORO_PREFER_PERL_FUNCTIONS
563# define coro_init_stacks init_stacks 564# define coro_init_stacks init_stacks
564#else 565#else
565static void 566static void
566coro_init_stacks (pTHX) 567coro_init_stacks (pTHX)
567{ 568{
… …
711 XPUSHs (sv_2mortal (av_shift (GvAV (PL_defgv)))); 712 XPUSHs (sv_2mortal (av_shift (GvAV (PL_defgv))));
712 PUTBACK; 713 PUTBACK;
713 PL_op = (OP *)&myop; 714 PL_op = (OP *)&myop;
714 PL_op = PL_ppaddr[OP_ENTERSUB](aTHX); 715 PL_op = PL_ppaddr[OP_ENTERSUB](aTHX);
715 SPAGAIN; 716 SPAGAIN;
717
718 /*
719 * now its very tricky. the "tail" of the next transfer might end up
720 * either in a new cctx, or an existing one.
721 * in case of an existing one we have to take care of whatever
722 * entersub and transfer do to the perl stack.
723 */
724 ENTER;
725 EXTEND (SP, 4);
726 PUSHs ((SV *)0); /* items */
727 PUSHs ((SV *)0); /* ix, set_stacklevel */
728 PUSHs ((SV *)(sp - PL_stack_base + 1)); /* ax */
729 PUSHs ((SV *)0); /* again */
730 PUTBACK;
716 } 731 }
717
718 ENTER; /* necessary e.g. for dounwind and to balance the xsub-entersub */
719} 732}
720 733
721static void 734static void
722coro_destroy (pTHX_ struct coro *coro) 735coro_destroy (pTHX_ struct coro *coro)
723{ 736{
… …
1019 1032
1020/* wether this cctx should be destructed */ 1033/* wether this cctx should be destructed */
1021#define CCTX_EXPIRED(cctx) ((cctx)->ssize < coro_stacksize || ((cctx)->flags & CC_NOREUSE)) 1034#define CCTX_EXPIRED(cctx) ((cctx)->ssize < coro_stacksize || ((cctx)->flags & CC_NOREUSE))
1022 1035
1023static coro_cctx * 1036static coro_cctx *
1024cctx_get (pTHX) 1037cctx_get (pTHX_ int gimme)
1025{ 1038{
1026 while (expect_true (cctx_first)) 1039 while (expect_true (cctx_first[gimme]))
1027 { 1040 {
1028 coro_cctx *cctx = cctx_first; 1041 coro_cctx *cctx = cctx_first[gimme];
1029 cctx_first = cctx->next; 1042 cctx_first[gimme] = cctx->next;
1030 --cctx_idle; 1043 --cctx_idle[gimme];
1031 1044
1032 if (expect_true (!CCTX_EXPIRED (cctx))) 1045 if (expect_true (!CCTX_EXPIRED (cctx)))
1033 return cctx; 1046 return cctx;
1034 1047
1035 cctx_destroy (cctx); 1048 cctx_destroy (cctx);
1036 } 1049 }
1037 1050
1051 assert (!gimme);
1038 return cctx_new (); 1052 return cctx_new ();
1039} 1053}
1040 1054
1041static void 1055static void
1042cctx_put (coro_cctx *cctx) 1056cctx_put (coro_cctx *cctx, int gimme)
1043{ 1057{
1044 /* free another cctx if overlimit */ 1058 /* free another cctx if overlimit */
1045 if (expect_false (cctx_idle >= MAX_IDLE_CCTX)) 1059 if (expect_false (cctx_idle[gimme] >= MAX_IDLE_CCTX))
1046 { 1060 {
1047 coro_cctx *first = cctx_first; 1061 coro_cctx *first = cctx_first[gimme];
1048 cctx_first = first->next; 1062 cctx_first[gimme] = first->next;
1049 --cctx_idle; 1063 --cctx_idle[gimme];
1050 1064
1051 cctx_destroy (first); 1065 cctx_destroy (first);
1052 } 1066 }
1053 1067
1054 ++cctx_idle; 1068 ++cctx_idle[gimme];
1055 cctx->next = cctx_first; 1069 cctx->next = cctx_first[gimme];
1056 cctx_first = cctx; 1070 cctx_first[gimme] = cctx;
1057} 1071}
1058 1072
1059/** coroutine switching *****************************************************/ 1073/** coroutine switching *****************************************************/
1060 1074
1061static void 1075static void
… …
1140 1154
1141 /* if the cctx is about to be destroyed we need to make sure we won't see it in cctx_get */ 1155 /* if the cctx is about to be destroyed we need to make sure we won't see it in cctx_get */
1142 /* without this the next cctx_get might destroy the prev__cctx while still in use */ 1156 /* without this the next cctx_get might destroy the prev__cctx while still in use */
1143 if (expect_false (CCTX_EXPIRED (prev__cctx))) 1157 if (expect_false (CCTX_EXPIRED (prev__cctx)))
1144 if (!next->cctx) 1158 if (!next->cctx)
1145 next->cctx = cctx_get (aTHX); 1159 next->cctx = cctx_get (aTHX_ next->gimme);
1146 1160
1147 cctx_put (prev__cctx); 1161 cctx_put (prev__cctx, prev->gimme);
1148 } 1162 }
1149 1163
1150 ++next->usecount; 1164 ++next->usecount;
1151 1165
1152 if (expect_true (!next->cctx)) 1166 if (expect_true (!next->cctx))
1153 next->cctx = cctx_get (aTHX); 1167 next->cctx = cctx_get (aTHX_ next->gimme);
1154 1168
1155 if (expect_false (prev__cctx != next->cctx)) 1169 if (expect_false (prev__cctx != next->cctx))
1156 { 1170 {
1157 prev__cctx->top_env = PL_top_env; 1171 prev__cctx->top_env = PL_top_env;
1158 PL_top_env = next->cctx->top_env; 1172 PL_top_env = next->cctx->top_env;
… …
1562# function to increase chances that they all will call transfer with the same 1576# function to increase chances that they all will call transfer with the same
1563# stack offset 1577# stack offset
1564void 1578void
1565_set_stacklevel (...) 1579_set_stacklevel (...)
1566 ALIAS: 1580 ALIAS:
1567 Coro::State::transfer = 1 1581 Coro::State::transfer = 1
1568 Coro::schedule = 2 1582 Coro::schedule = 2
1569 Coro::cede = 3 1583 Coro::cede = 3
1570 Coro::cede_notself = 4 1584 Coro::cede_notself = 4
1585 Coro::Event::next = 5
1586 Coro::Event::next_cancel = 6
1571 CODE: 1587 PPCODE:
1572{ 1588{
1573 struct transfer_args ta; 1589 struct transfer_args ta;
1590 int again = 0;
1574 1591
1575 switch (ix) 1592 do
1576 { 1593 {
1594 switch (ix)
1595 {
1577 case 0: 1596 case 0:
1578 ta.prev = (struct coro *)INT2PTR (coro_cctx *, SvIV (ST (0))); 1597 ta.prev = (struct coro *)INT2PTR (coro_cctx *, SvIV (ST (0)));
1579 ta.next = 0; 1598 ta.next = 0;
1580 break; 1599 break;
1581 1600
1582 case 1: 1601 case 1:
1583 if (items != 2) 1602 if (items != 2)
1584 croak ("Coro::State::transfer (prev,next) expects two arguments, not %d", items); 1603 croak ("Coro::State::transfer (prev,next) expects two arguments, not %d", items);
1585 1604
1586 prepare_transfer (aTHX_ &ta, ST (0), ST (1)); 1605 prepare_transfer (aTHX_ &ta, ST(0), ST(1));
1587 break; 1606 break;
1588 1607
1589 case 2: 1608 case 2:
1590 prepare_schedule (aTHX_ &ta); 1609 prepare_schedule (aTHX_ &ta);
1591 break; 1610 break;
1592 1611
1593 case 3: 1612 case 3:
1594 prepare_cede (aTHX_ &ta); 1613 prepare_cede (aTHX_ &ta);
1595 break; 1614 break;
1596 1615
1597 case 4: 1616 case 4:
1598 if (!prepare_cede_notself (aTHX_ &ta)) 1617 if (!prepare_cede_notself (aTHX_ &ta))
1599 XSRETURN_EMPTY; 1618 XSRETURN_EMPTY;
1600 1619
1601 break; 1620 break;
1621
1622 case 5:
1623 case 6:
1624 if (items != 1)
1625 croak ("Coro::Event::next (watcher) expects one argument, not %d", items);
1626
1627 {
1628 SV *ev = coroapi.coro_event_next (ST (0), ix == 6, GIMME_V != G_VOID);
1629
1630 if (ev)
1631 {
1632 if (GIMME_V != G_VOID)
1633 {
1634 XPUSHs (ev);
1635 XSRETURN (1);
1636 }
1637 else
1638 XSRETURN_EMPTY;
1639 }
1640 }
1641
1642 prepare_schedule (aTHX_ &ta);
1643 again = 1;
1644 break;
1645 }
1646
1647 /* our caller, entersub, caches *only* this value */
1648 ta.prev->gimme = GIMME_V == G_VOID ? 0
1649 : GIMME_V == G_SCALAR ? 1
1650 : 2;
1651
1652 /* we need to save all local variables, as we might execute a different coroutine when transfer returns */
1653 sp += 2; /* save args */
1654 EXTEND (SP, 4);
1655 PUSHs ((SV *)(intptr_t)items);
1656 PUSHs ((SV *)(intptr_t)ix);
1657 PUSHs ((SV *)(intptr_t)ax);
1658 PUSHs ((SV *)(intptr_t)again);
1659 PUTBACK;
1660 BARRIER;
1661 TRANSFER (ta);
1662 BARRIER;
1663 SPAGAIN;
1664 again = (intptr_t)POPs;
1665 ax = (intptr_t)POPs;
1666 ix = (intptr_t)POPs;
1667 items = (intptr_t)POPs;
1668 sp -= 2; /* restore args */
1602 } 1669 }
1603 1670 while (again);
1604 BARRIER;
1605 TRANSFER (ta);
1606 1671
1607 if (expect_false (GIMME_V != G_VOID && ta.next != ta.prev)) 1672 if (expect_false (GIMME_V != G_VOID && ta.next != ta.prev))
1608 XSRETURN_YES; 1673 XSRETURN_YES;
1674
1675 XSRETURN_EMPTY; /* not understood why this is necessary, likely some stack handling bug */
1609} 1676}
1610 1677
1611bool 1678bool
1612_destroy (SV *coro_sv) 1679_destroy (SV *coro_sv)
1613 CODE: 1680 CODE:
… …
1639 RETVAL 1706 RETVAL
1640 1707
1641int 1708int
1642cctx_idle () 1709cctx_idle ()
1643 CODE: 1710 CODE:
1644 RETVAL = cctx_idle; 1711 RETVAL = cctx_idle[0] + cctx_idle[1] + cctx_idle[2];
1645 OUTPUT: 1712 OUTPUT:
1646 RETVAL 1713 RETVAL
1647 1714
1648void 1715void
1649list () 1716list ()
… …
1673 1740
1674 { 1741 {
1675 dSP; 1742 dSP;
1676 ENTER; 1743 ENTER;
1677 SAVETMPS; 1744 SAVETMPS;
1745 PUTBACK;
1746 PUSHSTACK;
1678 PUSHMARK (SP); 1747 PUSHMARK (SP);
1679 PUTBACK;
1680 1748
1681 if (ix) 1749 if (ix)
1682 eval_sv (coderef, 0); 1750 eval_sv (coderef, 0);
1683 else 1751 else
1684 call_sv (coderef, G_KEEPERR | G_EVAL | G_VOID | G_DISCARD); 1752 call_sv (coderef, G_KEEPERR | G_EVAL | G_VOID | G_DISCARD);
1685 1753
1686 SPAGAIN; 1754 POPSTACK;
1687 FREETMPS; 1755 FREETMPS;
1688 LEAVE; 1756 LEAVE;
1689 PUTBACK;
1690 } 1757 }
1691 1758
1692 if (!(coro->flags & CF_RUNNING)) 1759 if (!(coro->flags & CF_RUNNING))
1693 { 1760 {
1694 save_perl (aTHX_ coro); 1761 save_perl (aTHX_ coro);

Diff Legend

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