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.265 by root, Fri Nov 14 02:42:26 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)
… …
713 } 711 }
714 712
715 return rss; 713 return rss;
716} 714}
717 715
716/** set stacklevel support **************************************************/
717
718/* we sometimes need to create the effect of pp_set_stacklevel calling us */
719#define SSL_HEAD (void)0
720/* we somtimes need to create the effect of leaving via pp_set_stacklevel */
721#define SSL_TAIL set_stacklevel_tail (aTHX)
722
723INLINE void
724set_stacklevel_tail (pTHX)
725{
726 dSP;
727 int gimme = GIMME_V;
728
729 if (gimme == G_SCALAR)
730 XPUSHs (&PL_sv_undef);
731
732 PUTBACK;
733}
734
718/** coroutine stack handling ************************************************/ 735/** coroutine stack handling ************************************************/
719 736
720static int (*orig_sigelem_get) (pTHX_ SV *sv, MAGIC *mg); 737static int (*orig_sigelem_get) (pTHX_ SV *sv, MAGIC *mg);
721static int (*orig_sigelem_set) (pTHX_ SV *sv, MAGIC *mg); 738static int (*orig_sigelem_set) (pTHX_ SV *sv, MAGIC *mg);
722static int (*orig_sigelem_clr) (pTHX_ SV *sv, MAGIC *mg); 739static int (*orig_sigelem_clr) (pTHX_ SV *sv, MAGIC *mg);
… …
725#ifndef MgPV_nolen_const 742#ifndef MgPV_nolen_const
726#define MgPV_nolen_const(mg) (((((int)(mg)->mg_len)) == HEf_SVKEY) ? \ 743#define MgPV_nolen_const(mg) (((((int)(mg)->mg_len)) == HEf_SVKEY) ? \
727 SvPV_nolen((SV*)((mg)->mg_ptr)) : \ 744 SvPV_nolen((SV*)((mg)->mg_ptr)) : \
728 (const char*)(mg)->mg_ptr) 745 (const char*)(mg)->mg_ptr)
729#endif 746#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 747
736/* 748/*
737 * This overrides the default magic get method of %SIG elements. 749 * 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 750 * 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 751 * and instead of tryign to save and restore the hash elements, we just provide
… …
859 PL_op = PL_ppaddr[OP_ENTERSUB](aTHX); 871 PL_op = PL_ppaddr[OP_ENTERSUB](aTHX);
860 SPAGAIN; 872 SPAGAIN;
861 } 873 }
862 874
863 /* this newly created coroutine might be run on an existing cctx which most 875 /* this newly created coroutine might be run on an existing cctx which most
864 * likely was suspended in set_stacklevel, called from entersub. 876 * likely was suspended in set_stacklevel, called from pp_set_stacklevel,
865 * set_stacklevel doesn't do anything on return, but entersub does LEAVE, 877 * so we have to emulate entering pp_set_stacklevel here.
866 * so we ENTER here for symmetry.
867 */ 878 */
868 ENTERSUB_HEAD; 879 SSL_HEAD;
869} 880}
870 881
871static void 882static void
872coro_destruct (pTHX_ struct coro *coro) 883coro_destruct (pTHX_ struct coro *coro)
873{ 884{
… …
1078INLINE void 1089INLINE void
1079transfer_tail (pTHX) 1090transfer_tail (pTHX)
1080{ 1091{
1081 struct coro *next = (struct coro *)transfer_next; 1092 struct coro *next = (struct coro *)transfer_next;
1082 assert (!(transfer_next = 0)); /* just used for the side effect when asserts are enabled */ 1093 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)); 1094 assert (("FATAL: next coroutine was zero in transfer_tail (please report)", next));
1084 1095
1085 free_coro_mortal (aTHX); 1096 free_coro_mortal (aTHX);
1086 UNLOCK; 1097 UNLOCK;
1087 1098
1088 if (expect_false (next->throw)) 1099 if (expect_false (next->throw))
… …
1107# endif 1118# endif
1108#endif 1119#endif
1109 { 1120 {
1110 dTHX; 1121 dTHX;
1111 1122
1112 /* entersub called ENTER, but we never 'returned', undo that here */ 1123 /* we are the alternative tail to pp_set_stacklevel */
1113 ENTERSUB_TAIL; 1124 /* so do the same things here */
1125 SSL_TAIL;
1114 1126
1115 /* we now skip the entersub that did lead to transfer() */ 1127 /* we now skip the op that did lead to transfer() */
1116 PL_op = PL_op->op_next; 1128 PL_op = PL_op->op_next;
1117 1129
1118 /* inject a fake subroutine call to cctx_init */ 1130 /* inject a fake subroutine call to cctx_init */
1119 cctx_prepare (aTHX_ (coro_cctx *)arg); 1131 cctx_prepare (aTHX_ (coro_cctx *)arg);
1120 1132
… …
1192 cctx->ssize = cctx_stacksize * (long)sizeof (long); 1204 cctx->ssize = cctx_stacksize * (long)sizeof (long);
1193 New (0, cctx->sptr, cctx_stacksize, long); 1205 New (0, cctx->sptr, cctx_stacksize, long);
1194 1206
1195 if (!cctx->sptr) 1207 if (!cctx->sptr)
1196 { 1208 {
1197 perror ("FATAL: unable to allocate stack for coroutine"); 1209 perror ("FATAL: unable to allocate stack for coroutine, exiting.");
1198 _exit (EXIT_FAILURE); 1210 _exit (EXIT_FAILURE);
1199 } 1211 }
1200 1212
1201 stack_start = cctx->sptr; 1213 stack_start = cctx->sptr;
1202 stack_size = cctx->ssize; 1214 stack_size = cctx->ssize;
… …
1810 PerlIOBuf_get_ptr, 1822 PerlIOBuf_get_ptr,
1811 PerlIOBuf_get_cnt, 1823 PerlIOBuf_get_cnt,
1812 PerlIOBuf_set_ptrcnt, 1824 PerlIOBuf_set_ptrcnt,
1813}; 1825};
1814 1826
1827/*****************************************************************************/
1828
1829static const CV *ssl_cv; /* for quick consistency check */
1830
1831static UNOP ssl_restore; /* restore stack as entersub did, for first-re-run */
1832static SV *ssl_arg0;
1833static SV *ssl_arg1;
1834
1835/* this restores the stack in the case we patched the entersub, to */
1836/* recreate the stack frame as perl will on following calls */
1837/* since entersub cleared the stack */
1838static OP *
1839pp_restore (pTHX)
1840{
1841 dSP;
1842
1843 PUSHMARK (SP);
1844
1845 EXTEND (SP, 3);
1846 if (ssl_arg0) PUSHs (sv_2mortal (ssl_arg0)), ssl_arg0 = 0;
1847 if (ssl_arg1) PUSHs (sv_2mortal (ssl_arg1)), ssl_arg1 = 0;
1848 PUSHs ((SV *)CvGV (ssl_cv));
1849
1850 RETURNOP (ssl_restore.op_first);
1851}
1852
1853/* declare prototype */
1854XS(XS_Coro__State__set_stacklevel);
1855
1856static OP *
1857pp_set_stacklevel (pTHX)
1858{
1859 dSP;
1860 struct transfer_args ta;
1861 SV **arg = PL_stack_base + TOPMARK + 1;
1862 int items = SP - arg; /* args without function object */
1863
1864 /* do a quick consistency check on the "function" object, and if it isn't */
1865 /* for us, divert to the real entersub */
1866 if (SvTYPE (*sp) != SVt_PVGV || CvXSUB (GvCV (*sp)) != XS_Coro__State__set_stacklevel)
1867 return PL_ppaddr[OP_ENTERSUB](aTHX);
1868
1869 /* pop args */
1870 SP = PL_stack_base + POPMARK;
1871
1872 if (!(PL_op->op_flags & OPf_STACKED))
1873 {
1874 /* ampersand-form of call, use @_ instead of stack */
1875 AV *av = GvAV (PL_defgv);
1876 arg = AvARRAY (av);
1877 items = AvFILLp (av) + 1;
1878 }
1879
1880 PUTBACK;
1881 switch (PL_op->op_private & 7)
1882 {
1883 case 0:
1884 prepare_set_stacklevel (&ta, (struct coro_cctx *)SvIV (arg [0]));
1885 break;
1886
1887 case 1:
1888 if (items != 2)
1889 croak ("Coro::State::transfer (prev, next) expects two arguments, not %d.", items);
1890
1891 prepare_transfer (aTHX_ &ta, arg [0], arg [1]);
1892 break;
1893
1894 case 2:
1895 prepare_schedule (aTHX_ &ta);
1896 break;
1897
1898 case 3:
1899 prepare_cede (aTHX_ &ta);
1900 break;
1901
1902 case 4:
1903 if (!prepare_cede_notself (aTHX_ &ta))
1904 goto skip;
1905
1906 break;
1907 }
1908
1909 TRANSFER (ta, 0);
1910 SPAGAIN;
1911
1912skip:
1913 PUTBACK;
1914 SSL_TAIL;
1915 SPAGAIN;
1916 RETURN;
1917}
1815 1918
1816MODULE = Coro::State PACKAGE = Coro::State PREFIX = api_ 1919MODULE = Coro::State PACKAGE = Coro::State PREFIX = api_
1817 1920
1818PROTOTYPES: DISABLE 1921PROTOTYPES: 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 1922
1899# these not obviously related functions are all rolled into the same xs 1923# 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 1924# function to increase chances that they all will call transfer with the same
1901# stack offset 1925# stack offset
1902void 1926void
… …
1906 Coro::schedule = 2 1930 Coro::schedule = 2
1907 Coro::cede = 3 1931 Coro::cede = 3
1908 Coro::cede_notself = 4 1932 Coro::cede_notself = 4
1909 CODE: 1933 CODE:
1910{ 1934{
1911 struct transfer_args ta; 1935 assert (("FATAL: ssl call recursion in Coro module (please report)", PL_op->op_ppaddr != pp_set_stacklevel));
1912 1936
1913 PUTBACK; 1937 /* we patch the op, and then re-run the whole call */
1914 switch (ix) 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
1915 { 1994 {
1916 case 0: 1995 SV **svp = hv_fetch (PL_modglobal, "Time::NVtime", 12, 0);
1917 prepare_set_stacklevel (&ta, (struct coro_cctx *)SvIV (ST (0)));
1918 break;
1919 1996
1920 case 1: 1997 if (!svp) croak ("Time::HiRes is required");
1921 if (items != 2) 1998 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 1999
1924 prepare_transfer (aTHX_ &ta, ST (0), ST (1)); 2000 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 } 2001 }
1941 SPAGAIN;
1942 2002
1943 BARRIER; 2003 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} 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
1949 2034
1950bool 2035bool
1951_destroy (SV *coro_sv) 2036_destroy (SV *coro_sv)
1952 CODE: 2037 CODE:
1953 RETVAL = coro_state_destroy (aTHX_ SvSTATE (coro_sv)); 2038 RETVAL = coro_state_destroy (aTHX_ SvSTATE (coro_sv));

Diff Legend

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