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.265 by root, Fri Nov 14 02:42:26 2008 UTC vs.
Revision 1.267 by root, Fri Nov 14 06:29:52 2008 UTC

715 715
716/** set stacklevel support **************************************************/ 716/** set stacklevel support **************************************************/
717 717
718/* we sometimes need to create the effect of pp_set_stacklevel calling us */ 718/* we sometimes need to create the effect of pp_set_stacklevel calling us */
719#define SSL_HEAD (void)0 719#define SSL_HEAD (void)0
720/* we somtimes need to create the effect of leaving via pp_set_stacklevel */ 720/* we sometimes need to create the effect of leaving via pp_set_stacklevel */
721#define SSL_TAIL set_stacklevel_tail (aTHX) 721#define SSL_TAIL set_stacklevel_tail (aTHX)
722 722
723INLINE void 723INLINE void
724set_stacklevel_tail (pTHX) 724set_stacklevel_tail (pTHX)
725{ 725{
726 dSP; 726 dSP;
727 SV **bot = SP;
728
727 int gimme = GIMME_V; 729 int gimme = GIMME_V;
728 730
731 /* make sure we put something on the stack in scalar context */
729 if (gimme == G_SCALAR) 732 if (gimme == G_SCALAR)
733 {
734 if (sp == bot)
730 XPUSHs (&PL_sv_undef); 735 XPUSHs (&PL_sv_undef);
736
737 SP = bot + 1;
738 }
731 739
732 PUTBACK; 740 PUTBACK;
733} 741}
734 742
735/** coroutine stack handling ************************************************/ 743/** coroutine stack handling ************************************************/
1647{ 1655{
1648 api_ready (coro_current); 1656 api_ready (coro_current);
1649 prepare_schedule (aTHX_ ta); 1657 prepare_schedule (aTHX_ ta);
1650} 1658}
1651 1659
1652static int 1660static void
1653prepare_cede_notself (pTHX_ struct transfer_args *ta) 1661prepare_cede_notself (pTHX_ struct transfer_args *ta)
1654{ 1662{
1663 SV *prev = SvRV (coro_current);
1664
1655 if (coro_nready) 1665 if (coro_nready)
1656 { 1666 {
1657 SV *prev = SvRV (coro_current);
1658 prepare_schedule (aTHX_ ta); 1667 prepare_schedule (aTHX_ ta);
1659 api_ready (prev); 1668 api_ready (prev);
1669 }
1670 else
1671 ta->prev = ta->next = SvSTATE (prev);
1672}
1673
1674static void
1675api_schedule (void)
1676{
1677 dTHX;
1678 struct transfer_args ta;
1679
1680 prepare_schedule (aTHX_ &ta);
1681 TRANSFER (ta, 1);
1682}
1683
1684static int
1685api_cede (void)
1686{
1687 dTHX;
1688 struct transfer_args ta;
1689
1690 prepare_cede (aTHX_ &ta);
1691
1692 if (expect_true (ta.prev != ta.next))
1693 {
1694 TRANSFER (ta, 1);
1660 return 1; 1695 return 1;
1661 } 1696 }
1662 else 1697 else
1663 return 0; 1698 return 0;
1664} 1699}
1665 1700
1666static void
1667api_schedule (void)
1668{
1669 dTHX;
1670 struct transfer_args ta;
1671
1672 prepare_schedule (aTHX_ &ta);
1673 TRANSFER (ta, 1);
1674}
1675
1676static int
1677api_cede (void)
1678{
1679 dTHX;
1680 struct transfer_args ta;
1681
1682 prepare_cede (aTHX_ &ta);
1683
1684 if (expect_true (ta.prev != ta.next))
1685 {
1686 TRANSFER (ta, 1);
1687 return 1;
1688 }
1689 else
1690 return 0;
1691}
1692
1693static int 1701static int
1694api_cede_notself (void) 1702api_cede_notself (void)
1695{ 1703{
1704 if (coro_nready)
1705 {
1696 dTHX; 1706 dTHX;
1697 struct transfer_args ta; 1707 struct transfer_args ta;
1698 1708
1699 if (prepare_cede_notself (aTHX_ &ta)) 1709 prepare_cede_notself (aTHX_ &ta);
1700 {
1701 TRANSFER (ta, 1); 1710 TRANSFER (ta, 1);
1702 return 1; 1711 return 1;
1703 } 1712 }
1704 else 1713 else
1705 return 0; 1714 return 0;
1848 PUSHs ((SV *)CvGV (ssl_cv)); 1857 PUSHs ((SV *)CvGV (ssl_cv));
1849 1858
1850 RETURNOP (ssl_restore.op_first); 1859 RETURNOP (ssl_restore.op_first);
1851} 1860}
1852 1861
1862#define OPpENTERSUB_SSL 15 /* the part of op_private entersub hopefully doesn't use */
1863
1853/* declare prototype */ 1864/* declare prototype */
1854XS(XS_Coro__State__set_stacklevel); 1865XS(XS_Coro__State__set_stacklevel);
1855 1866
1867/*
1868 * these not obviously related functions are all rolled into one
1869 * function to increase chances that they all will call transfer with the same
1870 * stack offset
1871 */
1856static OP * 1872static OP *
1857pp_set_stacklevel (pTHX) 1873pp_set_stacklevel (pTHX)
1858{ 1874{
1859 dSP; 1875 dSP;
1860 struct transfer_args ta; 1876 struct transfer_args ta;
1876 arg = AvARRAY (av); 1892 arg = AvARRAY (av);
1877 items = AvFILLp (av) + 1; 1893 items = AvFILLp (av) + 1;
1878 } 1894 }
1879 1895
1880 PUTBACK; 1896 PUTBACK;
1881 switch (PL_op->op_private & 7) 1897 switch (PL_op->op_private & OPpENTERSUB_SSL)
1882 { 1898 {
1883 case 0: 1899 case 0:
1884 prepare_set_stacklevel (&ta, (struct coro_cctx *)SvIV (arg [0])); 1900 prepare_set_stacklevel (&ta, (struct coro_cctx *)SvIV (arg [0]));
1885 break; 1901 break;
1886 1902
1898 case 3: 1914 case 3:
1899 prepare_cede (aTHX_ &ta); 1915 prepare_cede (aTHX_ &ta);
1900 break; 1916 break;
1901 1917
1902 case 4: 1918 case 4:
1903 if (!prepare_cede_notself (aTHX_ &ta)) 1919 prepare_cede_notself (aTHX_ &ta);
1904 goto skip;
1905
1906 break; 1920 break;
1907 } 1921 }
1908 1922
1909 TRANSFER (ta, 0); 1923 TRANSFER (ta, 0);
1910 SPAGAIN; 1924 SPAGAIN;
1914 SSL_TAIL; 1928 SSL_TAIL;
1915 SPAGAIN; 1929 SPAGAIN;
1916 RETURN; 1930 RETURN;
1917} 1931}
1918 1932
1933static void
1934coro_ssl_patch (pTHX_ CV *cv, int ix, SV **args, int items)
1935{
1936 assert (("FATAL: ssl call recursion in Coro module (please report)", PL_op->op_ppaddr != pp_set_stacklevel));
1937
1938 assert (("FATAL: ssl call with illegal CV value", CvGV (cv)));
1939 ssl_cv = cv;
1940
1941 /* we patch the op, and then re-run the whole call */
1942 /* we have to put some dummy argument on the stack for this to work */
1943 ssl_restore.op_next = (OP *)&ssl_restore;
1944 ssl_restore.op_type = OP_NULL;
1945 ssl_restore.op_ppaddr = pp_restore;
1946 ssl_restore.op_first = PL_op;
1947
1948 ssl_arg0 = items > 0 ? SvREFCNT_inc (args [0]) : 0;
1949 ssl_arg1 = items > 1 ? SvREFCNT_inc (args [1]) : 0;
1950
1951 PL_op->op_ppaddr = pp_set_stacklevel;
1952 PL_op->op_private = PL_op->op_private & ~OPpENTERSUB_SSL | ix; /* we potentially share our private flags with entersub */
1953
1954 PL_op = (OP *)&ssl_restore;
1955}
1956
1919MODULE = Coro::State PACKAGE = Coro::State PREFIX = api_ 1957MODULE = Coro::State PACKAGE = Coro::State PREFIX = api_
1920 1958
1921PROTOTYPES: DISABLE 1959PROTOTYPES: DISABLE
1922 1960
1923# these not obviously related functions are all rolled into the same xs 1961BOOT:
1924# function to increase chances that they all will call transfer with the same 1962{
1925# stack offset 1963#ifdef USE_ITHREADS
1964 MUTEX_INIT (&coro_lock);
1965# if CORO_PTHREAD
1966 coro_thx = PERL_GET_CONTEXT;
1967# endif
1968#endif
1969 BOOT_PAGESIZE;
1970
1971 irsgv = gv_fetchpv ("/" , GV_ADD|GV_NOTQUAL, SVt_PV);
1972 stdoutgv = gv_fetchpv ("STDOUT", GV_ADD|GV_NOTQUAL, SVt_PVIO);
1973
1974 orig_sigelem_get = PL_vtbl_sigelem.svt_get; PL_vtbl_sigelem.svt_get = coro_sigelem_get;
1975 orig_sigelem_set = PL_vtbl_sigelem.svt_set; PL_vtbl_sigelem.svt_set = coro_sigelem_set;
1976 orig_sigelem_clr = PL_vtbl_sigelem.svt_clear; PL_vtbl_sigelem.svt_clear = coro_sigelem_clr;
1977
1978 hv_sig = coro_get_hv (aTHX_ "SIG", TRUE);
1979 rv_diehook = newRV_inc ((SV *)gv_fetchpv ("Coro::State::diehook" , 0, SVt_PVCV));
1980 rv_warnhook = newRV_inc ((SV *)gv_fetchpv ("Coro::State::warnhook", 0, SVt_PVCV));
1981
1982 coro_state_stash = gv_stashpv ("Coro::State", TRUE);
1983
1984 newCONSTSUB (coro_state_stash, "CC_TRACE" , newSViv (CC_TRACE));
1985 newCONSTSUB (coro_state_stash, "CC_TRACE_SUB" , newSViv (CC_TRACE_SUB));
1986 newCONSTSUB (coro_state_stash, "CC_TRACE_LINE", newSViv (CC_TRACE_LINE));
1987 newCONSTSUB (coro_state_stash, "CC_TRACE_ALL" , newSViv (CC_TRACE_ALL));
1988
1989 main_mainstack = PL_mainstack;
1990 main_top_env = PL_top_env;
1991
1992 while (main_top_env->je_prev)
1993 main_top_env = main_top_env->je_prev;
1994
1995 coroapi.ver = CORO_API_VERSION;
1996 coroapi.rev = CORO_API_REVISION;
1997 coroapi.transfer = api_transfer;
1998
1999 {
2000 SV **svp = hv_fetch (PL_modglobal, "Time::NVtime", 12, 0);
2001
2002 if (!svp) croak ("Time::HiRes is required");
2003 if (!SvIOK (*svp)) croak ("Time::NVtime isn't a function pointer");
2004
2005 nvtime = INT2PTR (double (*)(), SvIV (*svp));
2006 }
2007
2008 assert (("PRIO_NORMAL must be 0", !PRIO_NORMAL));
2009}
2010
2011SV *
2012new (char *klass, ...)
2013 CODE:
2014{
2015 struct coro *coro;
2016 MAGIC *mg;
2017 HV *hv;
2018 int i;
2019
2020 Newz (0, coro, 1, struct coro);
2021 coro->args = newAV ();
2022 coro->flags = CF_NEW;
2023
2024 if (coro_first) coro_first->prev = coro;
2025 coro->next = coro_first;
2026 coro_first = coro;
2027
2028 coro->hv = hv = newHV ();
2029 mg = sv_magicext ((SV *)hv, 0, CORO_MAGIC_type_state, &coro_state_vtbl, (char *)coro, 0);
2030 mg->mg_flags |= MGf_DUP;
2031 RETVAL = sv_bless (newRV_noinc ((SV *)hv), gv_stashpv (klass, 1));
2032
2033 av_extend (coro->args, items - 1);
2034 for (i = 1; i < items; i++)
2035 av_push (coro->args, newSVsv (ST (i)));
2036}
2037 OUTPUT:
2038 RETVAL
2039
1926void 2040void
1927_set_stacklevel (...) 2041_set_stacklevel (...)
1928 ALIAS: 2042 ALIAS:
1929 Coro::State::transfer = 1 2043 Coro::State::transfer = 1
1930 Coro::schedule = 2 2044 Coro::schedule = 2
1931 Coro::cede = 3 2045 Coro::cede = 3
1932 Coro::cede_notself = 4 2046 Coro::cede_notself = 4
1933 CODE: 2047 CODE:
1934{ 2048 coro_ssl_patch (aTHX_ cv, ix, &ST (0), items);
1935 assert (("FATAL: ssl call recursion in Coro module (please report)", PL_op->op_ppaddr != pp_set_stacklevel));
1936
1937 /* we patch the op, and then re-run the whole call */
1938 /* we have to put some dummy argument on the stack for this to work */
1939 /* TODO: walk back the opcode chain (but how?), nuke the pp_gv etc. */
1940 ssl_restore.op_next = (OP *)&ssl_restore;
1941 ssl_restore.op_type = OP_NULL;
1942 ssl_restore.op_ppaddr = pp_restore;
1943 ssl_restore.op_first = PL_op;
1944
1945 ssl_arg0 = items > 0 ? SvREFCNT_inc (ST (0)) : 0;
1946 ssl_arg1 = items > 1 ? SvREFCNT_inc (ST (1)) : 0;
1947
1948 PL_op->op_ppaddr = pp_set_stacklevel;
1949 PL_op->op_private = PL_op->op_private & ~7 | ix; /* we potentially share our private flags with entersub */
1950
1951 PL_op = (OP *)&ssl_restore;
1952}
1953
1954BOOT:
1955{
1956#ifdef USE_ITHREADS
1957 MUTEX_INIT (&coro_lock);
1958# if CORO_PTHREAD
1959 coro_thx = PERL_GET_CONTEXT;
1960# endif
1961#endif
1962 BOOT_PAGESIZE;
1963
1964 ssl_cv = get_cv ("Coro::State::_set_stacklevel", 0);
1965
1966 irsgv = gv_fetchpv ("/" , GV_ADD|GV_NOTQUAL, SVt_PV);
1967 stdoutgv = gv_fetchpv ("STDOUT", GV_ADD|GV_NOTQUAL, SVt_PVIO);
1968
1969 orig_sigelem_get = PL_vtbl_sigelem.svt_get; PL_vtbl_sigelem.svt_get = coro_sigelem_get;
1970 orig_sigelem_set = PL_vtbl_sigelem.svt_set; PL_vtbl_sigelem.svt_set = coro_sigelem_set;
1971 orig_sigelem_clr = PL_vtbl_sigelem.svt_clear; PL_vtbl_sigelem.svt_clear = coro_sigelem_clr;
1972
1973 hv_sig = coro_get_hv (aTHX_ "SIG", TRUE);
1974 rv_diehook = newRV_inc ((SV *)gv_fetchpv ("Coro::State::diehook" , 0, SVt_PVCV));
1975 rv_warnhook = newRV_inc ((SV *)gv_fetchpv ("Coro::State::warnhook", 0, SVt_PVCV));
1976
1977 coro_state_stash = gv_stashpv ("Coro::State", TRUE);
1978
1979 newCONSTSUB (coro_state_stash, "CC_TRACE" , newSViv (CC_TRACE));
1980 newCONSTSUB (coro_state_stash, "CC_TRACE_SUB" , newSViv (CC_TRACE_SUB));
1981 newCONSTSUB (coro_state_stash, "CC_TRACE_LINE", newSViv (CC_TRACE_LINE));
1982 newCONSTSUB (coro_state_stash, "CC_TRACE_ALL" , newSViv (CC_TRACE_ALL));
1983
1984 main_mainstack = PL_mainstack;
1985 main_top_env = PL_top_env;
1986
1987 while (main_top_env->je_prev)
1988 main_top_env = main_top_env->je_prev;
1989
1990 coroapi.ver = CORO_API_VERSION;
1991 coroapi.rev = CORO_API_REVISION;
1992 coroapi.transfer = api_transfer;
1993
1994 {
1995 SV **svp = hv_fetch (PL_modglobal, "Time::NVtime", 12, 0);
1996
1997 if (!svp) croak ("Time::HiRes is required");
1998 if (!SvIOK (*svp)) croak ("Time::NVtime isn't a function pointer");
1999
2000 nvtime = INT2PTR (double (*)(), SvIV (*svp));
2001 }
2002
2003 assert (("PRIO_NORMAL must be 0", !PRIO_NORMAL));
2004}
2005
2006SV *
2007new (char *klass, ...)
2008 CODE:
2009{
2010 struct coro *coro;
2011 MAGIC *mg;
2012 HV *hv;
2013 int i;
2014
2015 Newz (0, coro, 1, struct coro);
2016 coro->args = newAV ();
2017 coro->flags = CF_NEW;
2018
2019 if (coro_first) coro_first->prev = coro;
2020 coro->next = coro_first;
2021 coro_first = coro;
2022
2023 coro->hv = hv = newHV ();
2024 mg = sv_magicext ((SV *)hv, 0, CORO_MAGIC_type_state, &coro_state_vtbl, (char *)coro, 0);
2025 mg->mg_flags |= MGf_DUP;
2026 RETVAL = sv_bless (newRV_noinc ((SV *)hv), gv_stashpv (klass, 1));
2027
2028 av_extend (coro->args, items - 1);
2029 for (i = 1; i < items; i++)
2030 av_push (coro->args, newSVsv (ST (i)));
2031}
2032 OUTPUT:
2033 RETVAL
2034 2049
2035bool 2050bool
2036_destroy (SV *coro_sv) 2051_destroy (SV *coro_sv)
2037 CODE: 2052 CODE:
2038 RETVAL = coro_state_destroy (aTHX_ SvSTATE (coro_sv)); 2053 RETVAL = coro_state_destroy (aTHX_ SvSTATE (coro_sv));

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines