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.264 by root, Fri Nov 14 02:29:09 2008 UTC

… …
123 123
124#define IN_DESTRUCT (PL_main_cv == Nullcv) 124#define IN_DESTRUCT (PL_main_cv == Nullcv)
125 125
126#if __GNUC__ >= 3 126#if __GNUC__ >= 3
127# define attribute(x) __attribute__(x) 127# define attribute(x) __attribute__(x)
128# define BARRIER __asm__ __volatile__ ("" : : : "memory")
129# define expect(expr,value) __builtin_expect ((expr),(value)) 128# define expect(expr,value) __builtin_expect ((expr),(value))
130# define INLINE static inline 129# define INLINE static inline
131#else 130#else
132# define attribute(x) 131# define attribute(x)
133# define BARRIER
134# define expect(expr,value) (expr) 132# define expect(expr,value) (expr)
135# define INLINE static 133# define INLINE static
136#endif 134#endif
137 135
138#define expect_false(expr) expect ((expr) != 0, 0) 136#define expect_false(expr) expect ((expr) != 0, 0)
… …
727 SvPV_nolen((SV*)((mg)->mg_ptr)) : \ 725 SvPV_nolen((SV*)((mg)->mg_ptr)) : \
728 (const char*)(mg)->mg_ptr) 726 (const char*)(mg)->mg_ptr)
729#endif 727#endif
730 728
731/* we sometimes need to create the effect of entersub calling us */ 729/* we sometimes need to create the effect of entersub calling us */
732#define ENTERSUB_HEAD ENTER; SAVETMPS 730#define SSL_HEAD (void)0
733/* we somtimes need to create the effect of leaving via entersub */ 731/* we somtimes need to create the effect of leaving via entersub */
734#define ENTERSUB_TAIL LEAVE 732#define SSL_TAIL (void)0
735 733
736/* 734/*
737 * This overrides the default magic get method of %SIG elements. 735 * 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 736 * 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 737 * and instead of tryign to save and restore the hash elements, we just provide
… …
863 /* this newly created coroutine might be run on an existing cctx which most 861 /* this newly created coroutine might be run on an existing cctx which most
864 * likely was suspended in set_stacklevel, called from entersub. 862 * likely was suspended in set_stacklevel, called from entersub.
865 * set_stacklevel doesn't do anything on return, but entersub does LEAVE, 863 * set_stacklevel doesn't do anything on return, but entersub does LEAVE,
866 * so we ENTER here for symmetry. 864 * so we ENTER here for symmetry.
867 */ 865 */
868 ENTERSUB_HEAD; 866 SSL_HEAD;
869} 867}
870 868
871static void 869static void
872coro_destruct (pTHX_ struct coro *coro) 870coro_destruct (pTHX_ struct coro *coro)
873{ 871{
… …
1078INLINE void 1076INLINE void
1079transfer_tail (pTHX) 1077transfer_tail (pTHX)
1080{ 1078{
1081 struct coro *next = (struct coro *)transfer_next; 1079 struct coro *next = (struct coro *)transfer_next;
1082 assert (!(transfer_next = 0)); /* just used for the side effect when asserts are enabled */ 1080 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)); 1081 assert (("FATAL: next coroutine was zero in transfer_tail (please report)", next));
1084 1082
1085 free_coro_mortal (aTHX); 1083 free_coro_mortal (aTHX);
1086 UNLOCK; 1084 UNLOCK;
1087 1085
1088 if (expect_false (next->throw)) 1086 if (expect_false (next->throw))
… …
1108#endif 1106#endif
1109 { 1107 {
1110 dTHX; 1108 dTHX;
1111 1109
1112 /* entersub called ENTER, but we never 'returned', undo that here */ 1110 /* entersub called ENTER, but we never 'returned', undo that here */
1113 ENTERSUB_TAIL; 1111 SSL_TAIL;
1114 1112
1115 /* we now skip the entersub that did lead to transfer() */ 1113 /* we now skip the op that did lead to transfer() */
1116 PL_op = PL_op->op_next; 1114 PL_op = PL_op->op_next;
1117 1115
1118 /* inject a fake subroutine call to cctx_init */ 1116 /* inject a fake subroutine call to cctx_init */
1119 cctx_prepare (aTHX_ (coro_cctx *)arg); 1117 cctx_prepare (aTHX_ (coro_cctx *)arg);
1120 1118
… …
1192 cctx->ssize = cctx_stacksize * (long)sizeof (long); 1190 cctx->ssize = cctx_stacksize * (long)sizeof (long);
1193 New (0, cctx->sptr, cctx_stacksize, long); 1191 New (0, cctx->sptr, cctx_stacksize, long);
1194 1192
1195 if (!cctx->sptr) 1193 if (!cctx->sptr)
1196 { 1194 {
1197 perror ("FATAL: unable to allocate stack for coroutine"); 1195 perror ("FATAL: unable to allocate stack for coroutine, exiting.");
1198 _exit (EXIT_FAILURE); 1196 _exit (EXIT_FAILURE);
1199 } 1197 }
1200 1198
1201 stack_start = cctx->sptr; 1199 stack_start = cctx->sptr;
1202 stack_size = cctx->ssize; 1200 stack_size = cctx->ssize;
… …
1810 PerlIOBuf_get_ptr, 1808 PerlIOBuf_get_ptr,
1811 PerlIOBuf_get_cnt, 1809 PerlIOBuf_get_cnt,
1812 PerlIOBuf_set_ptrcnt, 1810 PerlIOBuf_set_ptrcnt,
1813}; 1811};
1814 1812
1813/*****************************************************************************/
1814
1815static const CV *ssl_cv; /* for quick consistency check */
1816
1817static UNOP ssl_restore; /* restore stack as entersub did, for first-re-run */
1818static SV *ssl_arg0;
1819static SV *ssl_arg1;
1820
1821/* this restores the stack in the case we patched the entersub, to */
1822/* recreate the stack frame as perl will on following calls */
1823/* since entersub cleared the stack */
1824static OP *
1825pp_restore (pTHX)
1826{
1827 dSP;
1828
1829 PUSHMARK (SP);
1830
1831 EXTEND (SP, 3);
1832 if (ssl_arg0) PUSHs (sv_2mortal (ssl_arg0)), ssl_arg0 = 0;
1833 if (ssl_arg1) PUSHs (sv_2mortal (ssl_arg1)), ssl_arg1 = 0;
1834 PUSHs ((SV *)CvGV (ssl_cv));
1835
1836 RETURNOP (ssl_restore.op_first);
1837}
1838
1839/* declare prototype */
1840XS(XS_Coro__State__set_stacklevel);
1841
1842static OP *
1843pp_set_stacklevel (pTHX)
1844{
1845 dSP;
1846 struct transfer_args ta;
1847 SV **arg = PL_stack_base + TOPMARK + 1;
1848 int items = SP - arg; /* args without function object */
1849
1850 /* do a quick consistency check on the "function" object, and if it isn't */
1851 /* for us, divert to the real entersub */
1852 if (SvTYPE (*sp) != SVt_PVGV || CvXSUB (GvCV (*sp)) != XS_Coro__State__set_stacklevel)
1853 return PL_ppaddr[OP_ENTERSUB](aTHX);
1854
1855 /* pop args */
1856 SP = PL_stack_base + POPMARK;
1857
1858 if (!(PL_op->op_flags & OPf_STACKED))
1859 {
1860 /* ampersand-form of call, use @_ instead of stack */
1861 AV *av = GvAV (PL_defgv);
1862 arg = AvARRAY (av);
1863 items = AvFILLp (av) + 1;
1864 }
1865
1866 PUTBACK;
1867 switch (PL_op->op_private & 7)
1868 {
1869 case 0:
1870 prepare_set_stacklevel (&ta, (struct coro_cctx *)SvIV (arg [0]));
1871 break;
1872
1873 case 1:
1874 if (items != 2)
1875 croak ("Coro::State::transfer (prev, next) expects two arguments, not %d.", items);
1876
1877 prepare_transfer (aTHX_ &ta, arg [0], arg [1]);
1878 break;
1879
1880 case 2:
1881 prepare_schedule (aTHX_ &ta);
1882 break;
1883
1884 case 3:
1885 prepare_cede (aTHX_ &ta);
1886 break;
1887
1888 case 4:
1889 if (!prepare_cede_notself (aTHX_ &ta))
1890 RETURN;
1891
1892 break;
1893 }
1894
1895 TRANSFER (ta, 0);
1896 SPAGAIN;
1897
1898skip:
1899
1900 RETURN;
1901}
1815 1902
1816MODULE = Coro::State PACKAGE = Coro::State PREFIX = api_ 1903MODULE = Coro::State PACKAGE = Coro::State PREFIX = api_
1817 1904
1818PROTOTYPES: DISABLE 1905PROTOTYPES: DISABLE
1819
1820BOOT:
1821{
1822#ifdef USE_ITHREADS
1823 MUTEX_INIT (&coro_lock);
1824# if CORO_PTHREAD
1825 coro_thx = PERL_GET_CONTEXT;
1826# endif
1827#endif
1828 BOOT_PAGESIZE;
1829
1830 irsgv = gv_fetchpv ("/" , GV_ADD|GV_NOTQUAL, SVt_PV);
1831 stdoutgv = gv_fetchpv ("STDOUT", GV_ADD|GV_NOTQUAL, SVt_PVIO);
1832
1833 orig_sigelem_get = PL_vtbl_sigelem.svt_get; PL_vtbl_sigelem.svt_get = coro_sigelem_get;
1834 orig_sigelem_set = PL_vtbl_sigelem.svt_set; PL_vtbl_sigelem.svt_set = coro_sigelem_set;
1835 orig_sigelem_clr = PL_vtbl_sigelem.svt_clear; PL_vtbl_sigelem.svt_clear = coro_sigelem_clr;
1836
1837 hv_sig = coro_get_hv (aTHX_ "SIG", TRUE);
1838 rv_diehook = newRV_inc ((SV *)gv_fetchpv ("Coro::State::diehook" , 0, SVt_PVCV));
1839 rv_warnhook = newRV_inc ((SV *)gv_fetchpv ("Coro::State::warnhook", 0, SVt_PVCV));
1840
1841 coro_state_stash = gv_stashpv ("Coro::State", TRUE);
1842
1843 newCONSTSUB (coro_state_stash, "CC_TRACE" , newSViv (CC_TRACE));
1844 newCONSTSUB (coro_state_stash, "CC_TRACE_SUB" , newSViv (CC_TRACE_SUB));
1845 newCONSTSUB (coro_state_stash, "CC_TRACE_LINE", newSViv (CC_TRACE_LINE));
1846 newCONSTSUB (coro_state_stash, "CC_TRACE_ALL" , newSViv (CC_TRACE_ALL));
1847
1848 main_mainstack = PL_mainstack;
1849 main_top_env = PL_top_env;
1850
1851 while (main_top_env->je_prev)
1852 main_top_env = main_top_env->je_prev;
1853
1854 coroapi.ver = CORO_API_VERSION;
1855 coroapi.rev = CORO_API_REVISION;
1856 coroapi.transfer = api_transfer;
1857
1858 {
1859 SV **svp = hv_fetch (PL_modglobal, "Time::NVtime", 12, 0);
1860
1861 if (!svp) croak ("Time::HiRes is required");
1862 if (!SvIOK (*svp)) croak ("Time::NVtime isn't a function pointer");
1863
1864 nvtime = INT2PTR (double (*)(), SvIV (*svp));
1865 }
1866
1867 assert (("PRIO_NORMAL must be 0", !PRIO_NORMAL));
1868}
1869
1870SV *
1871new (char *klass, ...)
1872 CODE:
1873{
1874 struct coro *coro;
1875 MAGIC *mg;
1876 HV *hv;
1877 int i;
1878
1879 Newz (0, coro, 1, struct coro);
1880 coro->args = newAV ();
1881 coro->flags = CF_NEW;
1882
1883 if (coro_first) coro_first->prev = coro;
1884 coro->next = coro_first;
1885 coro_first = coro;
1886
1887 coro->hv = hv = newHV ();
1888 mg = sv_magicext ((SV *)hv, 0, CORO_MAGIC_type_state, &coro_state_vtbl, (char *)coro, 0);
1889 mg->mg_flags |= MGf_DUP;
1890 RETVAL = sv_bless (newRV_noinc ((SV *)hv), gv_stashpv (klass, 1));
1891
1892 av_extend (coro->args, items - 1);
1893 for (i = 1; i < items; i++)
1894 av_push (coro->args, newSVsv (ST (i)));
1895}
1896 OUTPUT:
1897 RETVAL
1898 1906
1899# these not obviously related functions are all rolled into the same xs 1907# 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 1908# function to increase chances that they all will call transfer with the same
1901# stack offset 1909# stack offset
1902void 1910void
… …
1906 Coro::schedule = 2 1914 Coro::schedule = 2
1907 Coro::cede = 3 1915 Coro::cede = 3
1908 Coro::cede_notself = 4 1916 Coro::cede_notself = 4
1909 CODE: 1917 CODE:
1910{ 1918{
1911 struct transfer_args ta; 1919 assert (("FATAL: ssl call recursion in Coro module (please report)", PL_op->op_ppaddr != pp_set_stacklevel));
1912 1920
1913 PUTBACK; 1921 /* we patch the op, and then re-run the whole call */
1914 switch (ix) 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
1915 { 1978 {
1916 case 0: 1979 SV **svp = hv_fetch (PL_modglobal, "Time::NVtime", 12, 0);
1917 prepare_set_stacklevel (&ta, (struct coro_cctx *)SvIV (ST (0)));
1918 break;
1919 1980
1920 case 1: 1981 if (!svp) croak ("Time::HiRes is required");
1921 if (items != 2) 1982 if (!SvIOK (*svp)) croak ("Time::NVtime isn't a function pointer");
1922 croak ("Coro::State::transfer (prev, next) expects two arguments, not %d", items);
1923 1983
1924 prepare_transfer (aTHX_ &ta, ST (0), ST (1)); 1984 nvtime = INT2PTR (double (*)(), SvIV (*svp));
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 } 1985 }
1941 SPAGAIN;
1942 1986
1943 BARRIER; 1987 assert (("PRIO_NORMAL must be 0", !PRIO_NORMAL));
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} 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
1949 2018
1950bool 2019bool
1951_destroy (SV *coro_sv) 2020_destroy (SV *coro_sv)
1952 CODE: 2021 CODE:
1953 RETVAL = coro_state_destroy (aTHX_ SvSTATE (coro_sv)); 2022 RETVAL = coro_state_destroy (aTHX_ SvSTATE (coro_sv));

Diff Legend

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