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.264 by root, Fri Nov 14 02:29:09 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)
… …
711 } 714 }
712 715
713 return rss; 716 return rss;
714} 717}
715 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
716/** coroutine stack handling ************************************************/ 746/** coroutine stack handling ************************************************/
717 747
718static int (*orig_sigelem_get) (pTHX_ SV *sv, MAGIC *mg); 748static int (*orig_sigelem_get) (pTHX_ SV *sv, MAGIC *mg);
719static int (*orig_sigelem_set) (pTHX_ SV *sv, MAGIC *mg); 749static int (*orig_sigelem_set) (pTHX_ SV *sv, MAGIC *mg);
720static int (*orig_sigelem_clr) (pTHX_ SV *sv, MAGIC *mg); 750static int (*orig_sigelem_clr) (pTHX_ SV *sv, MAGIC *mg);
… …
723#ifndef MgPV_nolen_const 753#ifndef MgPV_nolen_const
724#define MgPV_nolen_const(mg) (((((int)(mg)->mg_len)) == HEf_SVKEY) ? \ 754#define MgPV_nolen_const(mg) (((((int)(mg)->mg_len)) == HEf_SVKEY) ? \
725 SvPV_nolen((SV*)((mg)->mg_ptr)) : \ 755 SvPV_nolen((SV*)((mg)->mg_ptr)) : \
726 (const char*)(mg)->mg_ptr) 756 (const char*)(mg)->mg_ptr)
727#endif 757#endif
728
729/* we sometimes need to create the effect of entersub calling us */
730#define SSL_HEAD (void)0
731/* we somtimes need to create the effect of leaving via entersub */
732#define SSL_TAIL (void)0
733 758
734/* 759/*
735 * This overrides the default magic get method of %SIG elements. 760 * This overrides the default magic get method of %SIG elements.
736 * 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
737 * 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
… …
857 PL_op = PL_ppaddr[OP_ENTERSUB](aTHX); 882 PL_op = PL_ppaddr[OP_ENTERSUB](aTHX);
858 SPAGAIN; 883 SPAGAIN;
859 } 884 }
860 885
861 /* 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
862 * likely was suspended in set_stacklevel, called from entersub. 887 * likely was suspended in set_stacklevel, called from pp_set_stacklevel,
863 * set_stacklevel doesn't do anything on return, but entersub does LEAVE, 888 * so we have to emulate entering pp_set_stacklevel here.
864 * so we ENTER here for symmetry.
865 */ 889 */
866 SSL_HEAD; 890 SSL_HEAD;
867} 891}
868 892
869static void 893static void
… …
1105# endif 1129# endif
1106#endif 1130#endif
1107 { 1131 {
1108 dTHX; 1132 dTHX;
1109 1133
1110 /* entersub called ENTER, but we never 'returned', undo that here */ 1134 /* we are the alternative tail to pp_set_stacklevel */
1135 /* so do the same things here */
1111 SSL_TAIL; 1136 SSL_TAIL;
1112 1137
1113 /* we now skip the op that did lead to transfer() */ 1138 /* we now skip the op that did lead to transfer() */
1114 PL_op = PL_op->op_next; 1139 PL_op = PL_op->op_next;
1115 1140
… …
1307 dSTACKLEVEL; 1332 dSTACKLEVEL;
1308 1333
1309 /* sometimes transfer is only called to set idle_sp */ 1334 /* sometimes transfer is only called to set idle_sp */
1310 if (expect_false (!next)) 1335 if (expect_false (!next))
1311 { 1336 {
1312 ((coro_cctx *)prev)->idle_sp = STACKLEVEL; 1337 ((coro_cctx *)prev)->idle_sp = stacklevel;
1313 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 */
1314 } 1339 }
1315 else if (expect_true (prev != next)) 1340 else if (expect_true (prev != next))
1316 { 1341 {
1317 coro_cctx *prev__cctx; 1342 coro_cctx *prev__cctx;
… …
1344 1369
1345 prev__cctx = prev->cctx; 1370 prev__cctx = prev->cctx;
1346 1371
1347 /* possibly untie and reuse the cctx */ 1372 /* possibly untie and reuse the cctx */
1348 if (expect_true ( 1373 if (expect_true (
1349 prev__cctx->idle_sp == STACKLEVEL 1374 prev__cctx->idle_sp == stacklevel
1350 && !(prev__cctx->flags & CC_TRACE) 1375 && !(prev__cctx->flags & CC_TRACE)
1351 && !force_cctx 1376 && !force_cctx
1352 )) 1377 ))
1353 { 1378 {
1354 /* 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 */
1355 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));
1356 1381
1357 prev->cctx = 0; 1382 prev->cctx = 0;
1358 1383
1359 /* 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 */
… …
1633{ 1658{
1634 api_ready (coro_current); 1659 api_ready (coro_current);
1635 prepare_schedule (aTHX_ ta); 1660 prepare_schedule (aTHX_ ta);
1636} 1661}
1637 1662
1638static int 1663static void
1639prepare_cede_notself (pTHX_ struct transfer_args *ta) 1664prepare_cede_notself (pTHX_ struct transfer_args *ta)
1640{ 1665{
1666 SV *prev = SvRV (coro_current);
1667
1641 if (coro_nready) 1668 if (coro_nready)
1642 { 1669 {
1643 SV *prev = SvRV (coro_current);
1644 prepare_schedule (aTHX_ ta); 1670 prepare_schedule (aTHX_ ta);
1645 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);
1646 return 1; 1698 return 1;
1647 } 1699 }
1648 else 1700 else
1649 return 0; 1701 return 0;
1650} 1702}
1651 1703
1652static void
1653api_schedule (void)
1654{
1655 dTHX;
1656 struct transfer_args ta;
1657
1658 prepare_schedule (aTHX_ &ta);
1659 TRANSFER (ta, 1);
1660}
1661
1662static int
1663api_cede (void)
1664{
1665 dTHX;
1666 struct transfer_args ta;
1667
1668 prepare_cede (aTHX_ &ta);
1669
1670 if (expect_true (ta.prev != ta.next))
1671 {
1672 TRANSFER (ta, 1);
1673 return 1;
1674 }
1675 else
1676 return 0;
1677}
1678
1679static int 1704static int
1680api_cede_notself (void) 1705api_cede_notself (void)
1681{ 1706{
1707 if (coro_nready)
1708 {
1682 dTHX; 1709 dTHX;
1683 struct transfer_args ta; 1710 struct transfer_args ta;
1684 1711
1685 if (prepare_cede_notself (aTHX_ &ta)) 1712 prepare_cede_notself (aTHX_ &ta);
1686 {
1687 TRANSFER (ta, 1); 1713 TRANSFER (ta, 1);
1688 return 1; 1714 return 1;
1689 } 1715 }
1690 else 1716 else
1691 return 0; 1717 return 0;
… …
1834 PUSHs ((SV *)CvGV (ssl_cv)); 1860 PUSHs ((SV *)CvGV (ssl_cv));
1835 1861
1836 RETURNOP (ssl_restore.op_first); 1862 RETURNOP (ssl_restore.op_first);
1837} 1863}
1838 1864
1865#define OPpENTERSUB_SSL 15 /* the part of op_private entersub hopefully doesn't use */
1866
1839/* declare prototype */ 1867/* declare prototype */
1840XS(XS_Coro__State__set_stacklevel); 1868XS(XS_Coro__State__set_stacklevel);
1841 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 */
1842static OP * 1875static OP *
1843pp_set_stacklevel (pTHX) 1876pp_set_stacklevel (pTHX)
1844{ 1877{
1845 dSP; 1878 dSP;
1846 struct transfer_args ta; 1879 struct transfer_args ta;
… …
1862 arg = AvARRAY (av); 1895 arg = AvARRAY (av);
1863 items = AvFILLp (av) + 1; 1896 items = AvFILLp (av) + 1;
1864 } 1897 }
1865 1898
1866 PUTBACK; 1899 PUTBACK;
1867 switch (PL_op->op_private & 7) 1900 switch (PL_op->op_private & OPpENTERSUB_SSL)
1868 { 1901 {
1869 case 0: 1902 case 0:
1870 prepare_set_stacklevel (&ta, (struct coro_cctx *)SvIV (arg [0])); 1903 prepare_set_stacklevel (&ta, (struct coro_cctx *)SvIV (arg [0]));
1871 break; 1904 break;
1872 1905
… …
1884 case 3: 1917 case 3:
1885 prepare_cede (aTHX_ &ta); 1918 prepare_cede (aTHX_ &ta);
1886 break; 1919 break;
1887 1920
1888 case 4: 1921 case 4:
1889 if (!prepare_cede_notself (aTHX_ &ta)) 1922 prepare_cede_notself (aTHX_ &ta);
1890 RETURN;
1891
1892 break; 1923 break;
1893 } 1924 }
1894 1925
1895 TRANSFER (ta, 0); 1926 TRANSFER (ta, 0);
1896 SPAGAIN; 1927 SPAGAIN;
1897 1928
1898skip: 1929skip:
1899 1930 PUTBACK;
1931 SSL_TAIL;
1932 SPAGAIN;
1900 RETURN; 1933 RETURN;
1901} 1934}
1902 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}
1959
1903MODULE = Coro::State PACKAGE = Coro::State PREFIX = api_ 1960MODULE = Coro::State PACKAGE = Coro::State PREFIX = api_
1904 1961
1905PROTOTYPES: DISABLE 1962PROTOTYPES: DISABLE
1906 1963
1907# these not obviously related functions are all rolled into the same xs 1964BOOT:
1908# function to increase chances that they all will call transfer with the same 1965{
1909# stack offset 1966#ifdef USE_ITHREADS
1967 MUTEX_INIT (&coro_lock);
1968# if CORO_PTHREAD
1969 coro_thx = PERL_GET_CONTEXT;
1970# endif
1971#endif
1972 BOOT_PAGESIZE;
1973
1974 irsgv = gv_fetchpv ("/" , GV_ADD|GV_NOTQUAL, SVt_PV);
1975 stdoutgv = gv_fetchpv ("STDOUT", GV_ADD|GV_NOTQUAL, SVt_PVIO);
1976
1977 orig_sigelem_get = PL_vtbl_sigelem.svt_get; PL_vtbl_sigelem.svt_get = coro_sigelem_get;
1978 orig_sigelem_set = PL_vtbl_sigelem.svt_set; PL_vtbl_sigelem.svt_set = coro_sigelem_set;
1979 orig_sigelem_clr = PL_vtbl_sigelem.svt_clear; PL_vtbl_sigelem.svt_clear = coro_sigelem_clr;
1980
1981 hv_sig = coro_get_hv (aTHX_ "SIG", TRUE);
1982 rv_diehook = newRV_inc ((SV *)gv_fetchpv ("Coro::State::diehook" , 0, SVt_PVCV));
1983 rv_warnhook = newRV_inc ((SV *)gv_fetchpv ("Coro::State::warnhook", 0, SVt_PVCV));
1984
1985 coro_state_stash = gv_stashpv ("Coro::State", TRUE);
1986
1987 newCONSTSUB (coro_state_stash, "CC_TRACE" , newSViv (CC_TRACE));
1988 newCONSTSUB (coro_state_stash, "CC_TRACE_SUB" , newSViv (CC_TRACE_SUB));
1989 newCONSTSUB (coro_state_stash, "CC_TRACE_LINE", newSViv (CC_TRACE_LINE));
1990 newCONSTSUB (coro_state_stash, "CC_TRACE_ALL" , newSViv (CC_TRACE_ALL));
1991
1992 main_mainstack = PL_mainstack;
1993 main_top_env = PL_top_env;
1994
1995 while (main_top_env->je_prev)
1996 main_top_env = main_top_env->je_prev;
1997
1998 coroapi.ver = CORO_API_VERSION;
1999 coroapi.rev = CORO_API_REVISION;
2000 coroapi.transfer = api_transfer;
2001
2002 {
2003 SV **svp = hv_fetch (PL_modglobal, "Time::NVtime", 12, 0);
2004
2005 if (!svp) croak ("Time::HiRes is required");
2006 if (!SvIOK (*svp)) croak ("Time::NVtime isn't a function pointer");
2007
2008 nvtime = INT2PTR (double (*)(), SvIV (*svp));
2009 }
2010
2011 assert (("PRIO_NORMAL must be 0", !PRIO_NORMAL));
2012}
2013
2014SV *
2015new (char *klass, ...)
2016 CODE:
2017{
2018 struct coro *coro;
2019 MAGIC *mg;
2020 HV *hv;
2021 int i;
2022
2023 Newz (0, coro, 1, struct coro);
2024 coro->args = newAV ();
2025 coro->flags = CF_NEW;
2026
2027 if (coro_first) coro_first->prev = coro;
2028 coro->next = coro_first;
2029 coro_first = coro;
2030
2031 coro->hv = hv = newHV ();
2032 mg = sv_magicext ((SV *)hv, 0, CORO_MAGIC_type_state, &coro_state_vtbl, (char *)coro, 0);
2033 mg->mg_flags |= MGf_DUP;
2034 RETVAL = sv_bless (newRV_noinc ((SV *)hv), gv_stashpv (klass, 1));
2035
2036 av_extend (coro->args, items - 1);
2037 for (i = 1; i < items; i++)
2038 av_push (coro->args, newSVsv (ST (i)));
2039}
2040 OUTPUT:
2041 RETVAL
2042
1910void 2043void
1911_set_stacklevel (...) 2044_set_stacklevel (...)
1912 ALIAS: 2045 ALIAS:
1913 Coro::State::transfer = 1 2046 Coro::State::transfer = 1
1914 Coro::schedule = 2 2047 Coro::schedule = 2
1915 Coro::cede = 3 2048 Coro::cede = 3
1916 Coro::cede_notself = 4 2049 Coro::cede_notself = 4
1917 CODE: 2050 CODE:
1918{ 2051 coro_ssl_patch (aTHX_ cv, ix, &ST (0), items);
1919 assert (("FATAL: ssl call recursion in Coro module (please report)", PL_op->op_ppaddr != pp_set_stacklevel));
1920
1921 /* we patch the op, and then re-run the whole call */
1922 /* we have to put some dummy argument on the stack for this to work */
1923 /* TODO: walk back the opcode chain (but how?), nuke the pp_gv etc. */
1924 ssl_restore.op_next = (OP *)&ssl_restore;
1925 ssl_restore.op_type = OP_NULL;
1926 ssl_restore.op_ppaddr = pp_restore;
1927 ssl_restore.op_first = PL_op;
1928
1929 ssl_arg0 = items > 0 ? SvREFCNT_inc (ST (0)) : 0;
1930 ssl_arg1 = items > 1 ? SvREFCNT_inc (ST (1)) : 0;
1931
1932 PL_op->op_ppaddr = pp_set_stacklevel;
1933 PL_op->op_private = PL_op->op_private & ~7 | ix; /* we potentially share our private flags with entersub */
1934
1935 PL_op = (OP *)&ssl_restore;
1936}
1937
1938BOOT:
1939{
1940#ifdef USE_ITHREADS
1941 MUTEX_INIT (&coro_lock);
1942# if CORO_PTHREAD
1943 coro_thx = PERL_GET_CONTEXT;
1944# endif
1945#endif
1946 BOOT_PAGESIZE;
1947
1948 ssl_cv = get_cv ("Coro::State::_set_stacklevel", 0);
1949
1950 irsgv = gv_fetchpv ("/" , GV_ADD|GV_NOTQUAL, SVt_PV);
1951 stdoutgv = gv_fetchpv ("STDOUT", GV_ADD|GV_NOTQUAL, SVt_PVIO);
1952
1953 orig_sigelem_get = PL_vtbl_sigelem.svt_get; PL_vtbl_sigelem.svt_get = coro_sigelem_get;
1954 orig_sigelem_set = PL_vtbl_sigelem.svt_set; PL_vtbl_sigelem.svt_set = coro_sigelem_set;
1955 orig_sigelem_clr = PL_vtbl_sigelem.svt_clear; PL_vtbl_sigelem.svt_clear = coro_sigelem_clr;
1956
1957 hv_sig = coro_get_hv (aTHX_ "SIG", TRUE);
1958 rv_diehook = newRV_inc ((SV *)gv_fetchpv ("Coro::State::diehook" , 0, SVt_PVCV));
1959 rv_warnhook = newRV_inc ((SV *)gv_fetchpv ("Coro::State::warnhook", 0, SVt_PVCV));
1960
1961 coro_state_stash = gv_stashpv ("Coro::State", TRUE);
1962
1963 newCONSTSUB (coro_state_stash, "CC_TRACE" , newSViv (CC_TRACE));
1964 newCONSTSUB (coro_state_stash, "CC_TRACE_SUB" , newSViv (CC_TRACE_SUB));
1965 newCONSTSUB (coro_state_stash, "CC_TRACE_LINE", newSViv (CC_TRACE_LINE));
1966 newCONSTSUB (coro_state_stash, "CC_TRACE_ALL" , newSViv (CC_TRACE_ALL));
1967
1968 main_mainstack = PL_mainstack;
1969 main_top_env = PL_top_env;
1970
1971 while (main_top_env->je_prev)
1972 main_top_env = main_top_env->je_prev;
1973
1974 coroapi.ver = CORO_API_VERSION;
1975 coroapi.rev = CORO_API_REVISION;
1976 coroapi.transfer = api_transfer;
1977
1978 {
1979 SV **svp = hv_fetch (PL_modglobal, "Time::NVtime", 12, 0);
1980
1981 if (!svp) croak ("Time::HiRes is required");
1982 if (!SvIOK (*svp)) croak ("Time::NVtime isn't a function pointer");
1983
1984 nvtime = INT2PTR (double (*)(), SvIV (*svp));
1985 }
1986
1987 assert (("PRIO_NORMAL must be 0", !PRIO_NORMAL));
1988}
1989
1990SV *
1991new (char *klass, ...)
1992 CODE:
1993{
1994 struct coro *coro;
1995 MAGIC *mg;
1996 HV *hv;
1997 int i;
1998
1999 Newz (0, coro, 1, struct coro);
2000 coro->args = newAV ();
2001 coro->flags = CF_NEW;
2002
2003 if (coro_first) coro_first->prev = coro;
2004 coro->next = coro_first;
2005 coro_first = coro;
2006
2007 coro->hv = hv = newHV ();
2008 mg = sv_magicext ((SV *)hv, 0, CORO_MAGIC_type_state, &coro_state_vtbl, (char *)coro, 0);
2009 mg->mg_flags |= MGf_DUP;
2010 RETVAL = sv_bless (newRV_noinc ((SV *)hv), gv_stashpv (klass, 1));
2011
2012 av_extend (coro->args, items - 1);
2013 for (i = 1; i < items; i++)
2014 av_push (coro->args, newSVsv (ST (i)));
2015}
2016 OUTPUT:
2017 RETVAL
2018 2052
2019bool 2053bool
2020_destroy (SV *coro_sv) 2054_destroy (SV *coro_sv)
2021 CODE: 2055 CODE:
2022 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