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.263 by root, Wed Nov 12 04:49:06 2008 UTC vs.
Revision 1.268 by root, Fri Nov 14 06:41:41 2008 UTC

… …
116# define CORO_PREFER_PERL_FUNCTIONS 0 116# define CORO_PREFER_PERL_FUNCTIONS 0
117#endif 117#endif
118 118
119/* The next macros try to return the current stack pointer, in an as 119/* The next macros try to return the current stack pointer, in an as
120 * portable way as possible. */ 120 * portable way as possible. */
121#define dSTACKLEVEL volatile char stacklevel 121#if __GNUC__ >= 4
122#define STACKLEVEL ((void *)&stacklevel) 122# define dSTACKLEVEL void *stacklevel = __builtin_frame_address (0)
123#else
124# define dSTACKLEVEL volatile void *stacklevel = (volatile void *)&stacklevel
125#endif
123 126
124#define IN_DESTRUCT (PL_main_cv == Nullcv) 127#define IN_DESTRUCT (PL_main_cv == Nullcv)
125 128
126#if __GNUC__ >= 3 129#if __GNUC__ >= 3
127# define attribute(x) __attribute__(x) 130# define attribute(x) __attribute__(x)
128# define BARRIER __asm__ __volatile__ ("" : : : "memory")
129# define expect(expr,value) __builtin_expect ((expr),(value)) 131# define expect(expr,value) __builtin_expect ((expr),(value))
130# define INLINE static inline 132# define INLINE static inline
131#else 133#else
132# define attribute(x) 134# define attribute(x)
133# define BARRIER
134# define expect(expr,value) (expr) 135# define expect(expr,value) (expr)
135# define INLINE static 136# define INLINE static
136#endif 137#endif
137 138
138#define expect_false(expr) expect ((expr) != 0, 0) 139#define expect_false(expr) expect ((expr) != 0, 0)
… …
713 } 714 }
714 715
715 return rss; 716 return rss;
716} 717}
717 718
719/** set stacklevel support **************************************************/
720
721/* we sometimes need to create the effect of pp_set_stacklevel calling us */
722#define SSL_HEAD (void)0
723/* we sometimes need to create the effect of leaving via pp_set_stacklevel */
724#define SSL_TAIL set_stacklevel_tail (aTHX)
725
726INLINE void
727set_stacklevel_tail (pTHX)
728{
729 dSP;
730 SV **bot = SP;
731
732 int gimme = GIMME_V;
733
734 /* make sure we put something on the stack in scalar context */
735 if (gimme == G_SCALAR)
736 {
737 if (sp == bot)
738 XPUSHs (&PL_sv_undef);
739
740 SP = bot + 1;
741 }
742
743 PUTBACK;
744}
745
718/** coroutine stack handling ************************************************/ 746/** coroutine stack handling ************************************************/
719 747
720static int (*orig_sigelem_get) (pTHX_ SV *sv, MAGIC *mg); 748static int (*orig_sigelem_get) (pTHX_ SV *sv, MAGIC *mg);
721static int (*orig_sigelem_set) (pTHX_ SV *sv, MAGIC *mg); 749static int (*orig_sigelem_set) (pTHX_ SV *sv, MAGIC *mg);
722static int (*orig_sigelem_clr) (pTHX_ SV *sv, MAGIC *mg); 750static int (*orig_sigelem_clr) (pTHX_ SV *sv, MAGIC *mg);
… …
725#ifndef MgPV_nolen_const 753#ifndef MgPV_nolen_const
726#define MgPV_nolen_const(mg) (((((int)(mg)->mg_len)) == HEf_SVKEY) ? \ 754#define MgPV_nolen_const(mg) (((((int)(mg)->mg_len)) == HEf_SVKEY) ? \
727 SvPV_nolen((SV*)((mg)->mg_ptr)) : \ 755 SvPV_nolen((SV*)((mg)->mg_ptr)) : \
728 (const char*)(mg)->mg_ptr) 756 (const char*)(mg)->mg_ptr)
729#endif 757#endif
730
731/* we sometimes need to create the effect of entersub calling us */
732#define ENTERSUB_HEAD ENTER; SAVETMPS
733/* we somtimes need to create the effect of leaving via entersub */
734#define ENTERSUB_TAIL LEAVE
735 758
736/* 759/*
737 * This overrides the default magic get method of %SIG elements. 760 * This overrides the default magic get method of %SIG elements.
738 * The original one doesn't provide for reading back of PL_diehook/PL_warnhook 761 * The original one doesn't provide for reading back of PL_diehook/PL_warnhook
739 * and instead of tryign to save and restore the hash elements, we just provide 762 * and instead of tryign to save and restore the hash elements, we just provide
… …
859 PL_op = PL_ppaddr[OP_ENTERSUB](aTHX); 882 PL_op = PL_ppaddr[OP_ENTERSUB](aTHX);
860 SPAGAIN; 883 SPAGAIN;
861 } 884 }
862 885
863 /* this newly created coroutine might be run on an existing cctx which most 886 /* this newly created coroutine might be run on an existing cctx which most
864 * likely was suspended in set_stacklevel, called from entersub. 887 * likely was suspended in set_stacklevel, called from pp_set_stacklevel,
865 * set_stacklevel doesn't do anything on return, but entersub does LEAVE, 888 * so we have to emulate entering pp_set_stacklevel here.
866 * so we ENTER here for symmetry.
867 */ 889 */
868 ENTERSUB_HEAD; 890 SSL_HEAD;
869} 891}
870 892
871static void 893static void
872coro_destruct (pTHX_ struct coro *coro) 894coro_destruct (pTHX_ struct coro *coro)
873{ 895{
… …
1078INLINE void 1100INLINE void
1079transfer_tail (pTHX) 1101transfer_tail (pTHX)
1080{ 1102{
1081 struct coro *next = (struct coro *)transfer_next; 1103 struct coro *next = (struct coro *)transfer_next;
1082 assert (!(transfer_next = 0)); /* just used for the side effect when asserts are enabled */ 1104 assert (!(transfer_next = 0)); /* just used for the side effect when asserts are enabled */
1083 assert (("FATAL: transfer_next was zero in transfer_tail (please report)", next)); 1105 assert (("FATAL: next coroutine was zero in transfer_tail (please report)", next));
1084 1106
1085 free_coro_mortal (aTHX); 1107 free_coro_mortal (aTHX);
1086 UNLOCK; 1108 UNLOCK;
1087 1109
1088 if (expect_false (next->throw)) 1110 if (expect_false (next->throw))
… …
1107# endif 1129# endif
1108#endif 1130#endif
1109 { 1131 {
1110 dTHX; 1132 dTHX;
1111 1133
1112 /* entersub called ENTER, but we never 'returned', undo that here */ 1134 /* we are the alternative tail to pp_set_stacklevel */
1113 ENTERSUB_TAIL; 1135 /* so do the same things here */
1136 SSL_TAIL;
1114 1137
1115 /* we now skip the entersub that did lead to transfer() */ 1138 /* we now skip the op that did lead to transfer() */
1116 PL_op = PL_op->op_next; 1139 PL_op = PL_op->op_next;
1117 1140
1118 /* inject a fake subroutine call to cctx_init */ 1141 /* inject a fake subroutine call to cctx_init */
1119 cctx_prepare (aTHX_ (coro_cctx *)arg); 1142 cctx_prepare (aTHX_ (coro_cctx *)arg);
1120 1143
… …
1192 cctx->ssize = cctx_stacksize * (long)sizeof (long); 1215 cctx->ssize = cctx_stacksize * (long)sizeof (long);
1193 New (0, cctx->sptr, cctx_stacksize, long); 1216 New (0, cctx->sptr, cctx_stacksize, long);
1194 1217
1195 if (!cctx->sptr) 1218 if (!cctx->sptr)
1196 { 1219 {
1197 perror ("FATAL: unable to allocate stack for coroutine"); 1220 perror ("FATAL: unable to allocate stack for coroutine, exiting.");
1198 _exit (EXIT_FAILURE); 1221 _exit (EXIT_FAILURE);
1199 } 1222 }
1200 1223
1201 stack_start = cctx->sptr; 1224 stack_start = cctx->sptr;
1202 stack_size = cctx->ssize; 1225 stack_size = cctx->ssize;
… …
1309 dSTACKLEVEL; 1332 dSTACKLEVEL;
1310 1333
1311 /* sometimes transfer is only called to set idle_sp */ 1334 /* sometimes transfer is only called to set idle_sp */
1312 if (expect_false (!next)) 1335 if (expect_false (!next))
1313 { 1336 {
1314 ((coro_cctx *)prev)->idle_sp = STACKLEVEL; 1337 ((coro_cctx *)prev)->idle_sp = stacklevel;
1315 assert (((coro_cctx *)prev)->idle_te = PL_top_env); /* just for the side-effect when asserts are enabled */ 1338 assert (((coro_cctx *)prev)->idle_te = PL_top_env); /* just for the side-effect when asserts are enabled */
1316 } 1339 }
1317 else if (expect_true (prev != next)) 1340 else if (expect_true (prev != next))
1318 { 1341 {
1319 coro_cctx *prev__cctx; 1342 coro_cctx *prev__cctx;
… …
1346 1369
1347 prev__cctx = prev->cctx; 1370 prev__cctx = prev->cctx;
1348 1371
1349 /* possibly untie and reuse the cctx */ 1372 /* possibly untie and reuse the cctx */
1350 if (expect_true ( 1373 if (expect_true (
1351 prev__cctx->idle_sp == STACKLEVEL 1374 prev__cctx->idle_sp == stacklevel
1352 && !(prev__cctx->flags & CC_TRACE) 1375 && !(prev__cctx->flags & CC_TRACE)
1353 && !force_cctx 1376 && !force_cctx
1354 )) 1377 ))
1355 { 1378 {
1356 /* I assume that STACKLEVEL is a stronger indicator than PL_top_env changes */ 1379 /* I assume that stacklevel is a stronger indicator than PL_top_env changes */
1357 assert (("FATAL: current top_env must equal previous top_env in Coro (please report)", PL_top_env == prev__cctx->idle_te)); 1380 assert (("FATAL: current top_env must equal previous top_env in Coro (please report)", PL_top_env == prev__cctx->idle_te));
1358 1381
1359 prev->cctx = 0; 1382 prev->cctx = 0;
1360 1383
1361 /* if the cctx is about to be destroyed we need to make sure we won't see it in cctx_get */ 1384 /* if the cctx is about to be destroyed we need to make sure we won't see it in cctx_get */
… …
1635{ 1658{
1636 api_ready (coro_current); 1659 api_ready (coro_current);
1637 prepare_schedule (aTHX_ ta); 1660 prepare_schedule (aTHX_ ta);
1638} 1661}
1639 1662
1640static int 1663static void
1641prepare_cede_notself (pTHX_ struct transfer_args *ta) 1664prepare_cede_notself (pTHX_ struct transfer_args *ta)
1642{ 1665{
1666 SV *prev = SvRV (coro_current);
1667
1643 if (coro_nready) 1668 if (coro_nready)
1644 { 1669 {
1645 SV *prev = SvRV (coro_current);
1646 prepare_schedule (aTHX_ ta); 1670 prepare_schedule (aTHX_ ta);
1647 api_ready (prev); 1671 api_ready (prev);
1672 }
1673 else
1674 ta->prev = ta->next = SvSTATE (prev);
1675}
1676
1677static void
1678api_schedule (void)
1679{
1680 dTHX;
1681 struct transfer_args ta;
1682
1683 prepare_schedule (aTHX_ &ta);
1684 TRANSFER (ta, 1);
1685}
1686
1687static int
1688api_cede (void)
1689{
1690 dTHX;
1691 struct transfer_args ta;
1692
1693 prepare_cede (aTHX_ &ta);
1694
1695 if (expect_true (ta.prev != ta.next))
1696 {
1697 TRANSFER (ta, 1);
1648 return 1; 1698 return 1;
1649 } 1699 }
1650 else 1700 else
1651 return 0; 1701 return 0;
1652} 1702}
1653 1703
1654static void
1655api_schedule (void)
1656{
1657 dTHX;
1658 struct transfer_args ta;
1659
1660 prepare_schedule (aTHX_ &ta);
1661 TRANSFER (ta, 1);
1662}
1663
1664static int
1665api_cede (void)
1666{
1667 dTHX;
1668 struct transfer_args ta;
1669
1670 prepare_cede (aTHX_ &ta);
1671
1672 if (expect_true (ta.prev != ta.next))
1673 {
1674 TRANSFER (ta, 1);
1675 return 1;
1676 }
1677 else
1678 return 0;
1679}
1680
1681static int 1704static int
1682api_cede_notself (void) 1705api_cede_notself (void)
1683{ 1706{
1707 if (coro_nready)
1708 {
1684 dTHX; 1709 dTHX;
1685 struct transfer_args ta; 1710 struct transfer_args ta;
1686 1711
1687 if (prepare_cede_notself (aTHX_ &ta)) 1712 prepare_cede_notself (aTHX_ &ta);
1688 {
1689 TRANSFER (ta, 1); 1713 TRANSFER (ta, 1);
1690 return 1; 1714 return 1;
1691 } 1715 }
1692 else 1716 else
1693 return 0; 1717 return 0;
… …
1810 PerlIOBuf_get_ptr, 1834 PerlIOBuf_get_ptr,
1811 PerlIOBuf_get_cnt, 1835 PerlIOBuf_get_cnt,
1812 PerlIOBuf_set_ptrcnt, 1836 PerlIOBuf_set_ptrcnt,
1813}; 1837};
1814 1838
1839/*****************************************************************************/
1840
1841static const CV *ssl_cv; /* for quick consistency check */
1842
1843static UNOP ssl_restore; /* restore stack as entersub did, for first-re-run */
1844static SV *ssl_arg0;
1845static SV *ssl_arg1;
1846
1847/* this restores the stack in the case we patched the entersub, to */
1848/* recreate the stack frame as perl will on following calls */
1849/* since entersub cleared the stack */
1850static OP *
1851pp_restore (pTHX)
1852{
1853 dSP;
1854
1855 PUSHMARK (SP);
1856
1857 EXTEND (SP, 3);
1858 if (ssl_arg0) PUSHs (sv_2mortal (ssl_arg0)), ssl_arg0 = 0;
1859 if (ssl_arg1) PUSHs (sv_2mortal (ssl_arg1)), ssl_arg1 = 0;
1860 PUSHs ((SV *)CvGV (ssl_cv));
1861
1862 RETURNOP (ssl_restore.op_first);
1863}
1864
1865#define OPpENTERSUB_SSL 15 /* the part of op_private entersub hopefully doesn't use */
1866
1867/* declare prototype */
1868XS(XS_Coro__State__set_stacklevel);
1869
1870/*
1871 * these not obviously related functions are all rolled into one
1872 * function to increase chances that they all will call transfer with the same
1873 * stack offset
1874 */
1875static OP *
1876pp_set_stacklevel (pTHX)
1877{
1878 dSP;
1879 struct transfer_args ta;
1880 SV **arg = PL_stack_base + TOPMARK + 1;
1881 int items = SP - arg; /* args without function object */
1882
1883 /* do a quick consistency check on the "function" object, and if it isn't */
1884 /* for us, divert to the real entersub */
1885 if (SvTYPE (*sp) != SVt_PVGV || CvXSUB (GvCV (*sp)) != XS_Coro__State__set_stacklevel)
1886 return PL_ppaddr[OP_ENTERSUB](aTHX);
1887
1888 /* pop args */
1889 SP = PL_stack_base + POPMARK;
1890
1891 if (!(PL_op->op_flags & OPf_STACKED))
1892 {
1893 /* ampersand-form of call, use @_ instead of stack */
1894 AV *av = GvAV (PL_defgv);
1895 arg = AvARRAY (av);
1896 items = AvFILLp (av) + 1;
1897 }
1898
1899 PUTBACK;
1900 switch (PL_op->op_private & OPpENTERSUB_SSL)
1901 {
1902 case 0:
1903 prepare_set_stacklevel (&ta, (struct coro_cctx *)SvIV (arg [0]));
1904 break;
1905
1906 case 1:
1907 if (items != 2)
1908 croak ("Coro::State::transfer (prev, next) expects two arguments, not %d.", items);
1909
1910 prepare_transfer (aTHX_ &ta, arg [0], arg [1]);
1911 break;
1912
1913 case 2:
1914 prepare_schedule (aTHX_ &ta);
1915 break;
1916
1917 case 3:
1918 prepare_cede (aTHX_ &ta);
1919 break;
1920
1921 case 4:
1922 prepare_cede_notself (aTHX_ &ta);
1923 break;
1924 }
1925
1926 TRANSFER (ta, 0);
1927 SPAGAIN;
1928
1929skip:
1930 PUTBACK;
1931 SSL_TAIL;
1932 SPAGAIN;
1933 RETURN;
1934}
1935
1936static void
1937coro_ssl_patch (pTHX_ CV *cv, int ix, SV **args, int items)
1938{
1939 assert (("FATAL: ssl call recursion in Coro module (please report)", PL_op->op_ppaddr != pp_set_stacklevel));
1940
1941 assert (("FATAL: ssl call with illegal CV value", CvGV (cv)));
1942 ssl_cv = cv;
1943
1944 /* we patch the op, and then re-run the whole call */
1945 /* we have to put some dummy argument on the stack for this to work */
1946 ssl_restore.op_next = (OP *)&ssl_restore;
1947 ssl_restore.op_type = OP_NULL;
1948 ssl_restore.op_ppaddr = pp_restore;
1949 ssl_restore.op_first = PL_op;
1950
1951 ssl_arg0 = items > 0 ? SvREFCNT_inc (args [0]) : 0;
1952 ssl_arg1 = items > 1 ? SvREFCNT_inc (args [1]) : 0;
1953
1954 PL_op->op_ppaddr = pp_set_stacklevel;
1955 PL_op->op_private = PL_op->op_private & ~OPpENTERSUB_SSL | ix; /* we potentially share our private flags with entersub */
1956
1957 PL_op = (OP *)&ssl_restore;
1958}
1815 1959
1816MODULE = Coro::State PACKAGE = Coro::State PREFIX = api_ 1960MODULE = Coro::State PACKAGE = Coro::State PREFIX = api_
1817 1961
1818PROTOTYPES: DISABLE 1962PROTOTYPES: DISABLE
1819 1963
… …
1894 av_push (coro->args, newSVsv (ST (i))); 2038 av_push (coro->args, newSVsv (ST (i)));
1895} 2039}
1896 OUTPUT: 2040 OUTPUT:
1897 RETVAL 2041 RETVAL
1898 2042
1899# these not obviously related functions are all rolled into the same xs
1900# function to increase chances that they all will call transfer with the same
1901# stack offset
1902void 2043void
1903_set_stacklevel (...) 2044_set_stacklevel (...)
1904 ALIAS: 2045 ALIAS:
1905 Coro::State::transfer = 1 2046 Coro::State::transfer = 1
1906 Coro::schedule = 2 2047 Coro::schedule = 2
1907 Coro::cede = 3 2048 Coro::cede = 3
1908 Coro::cede_notself = 4 2049 Coro::cede_notself = 4
1909 CODE: 2050 CODE:
1910{ 2051 coro_ssl_patch (aTHX_ cv, ix, &ST (0), items);
1911 struct transfer_args ta;
1912
1913 PUTBACK;
1914 switch (ix)
1915 {
1916 case 0:
1917 prepare_set_stacklevel (&ta, (struct coro_cctx *)SvIV (ST (0)));
1918 break;
1919
1920 case 1:
1921 if (items != 2)
1922 croak ("Coro::State::transfer (prev, next) expects two arguments, not %d", items);
1923
1924 prepare_transfer (aTHX_ &ta, ST (0), ST (1));
1925 break;
1926
1927 case 2:
1928 prepare_schedule (aTHX_ &ta);
1929 break;
1930
1931 case 3:
1932 prepare_cede (aTHX_ &ta);
1933 break;
1934
1935 case 4:
1936 if (!prepare_cede_notself (aTHX_ &ta))
1937 XSRETURN_EMPTY;
1938
1939 break;
1940 }
1941 SPAGAIN;
1942
1943 BARRIER;
1944 PUTBACK;
1945 TRANSFER (ta, 0);
1946 SPAGAIN; /* might be the sp of a different coroutine now */
1947 /* be extra careful not to ever do anything after TRANSFER */
1948}
1949 2052
1950bool 2053bool
1951_destroy (SV *coro_sv) 2054_destroy (SV *coro_sv)
1952 CODE: 2055 CODE:
1953 RETVAL = coro_state_destroy (aTHX_ SvSTATE (coro_sv)); 2056 RETVAL = coro_state_destroy (aTHX_ SvSTATE (coro_sv));

Diff Legend

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