[ViewVC] Diff of: cvs/Coro/Coro/State.xs

Comparing Coro/Coro/State.xs (file contents):
Revision 1.237 by root, Fri May 23 00:27:06 2008 UTC vs.
Revision 1.247 by root, Wed Sep 24 21:31:29 2008 UTC

…		…
4	#define PERL_EXT	4	#define PERL_EXT
5		5
6	#include "EXTERN.h"	6	#include "EXTERN.h"
7	#include "perl.h"	7	#include "perl.h"
8	#include "XSUB.h"	8	#include "XSUB.h"
		9	#include "perliol.h"
9		10
10	#include "patchlevel.h"	11	#include "patchlevel.h"
11		12
12	#include <stdio.h>	13	#include <stdio.h>
13	#include <errno.h>	14	#include <errno.h>
…		…
153	I32 laststype;	154	I32 laststype;
154	int laststatval;	155	int laststatval;
155	Stat_t statcache;	156	Stat_t statcache;
156	};	157	};
157		158
		159	static double (nvtime)(); / so why doesn't it take void? */
		160
158	static size_t coro_stacksize = CORO_STACKSIZE;	161	static size_t coro_stacksize = CORO_STACKSIZE;
159	static struct CoroAPI coroapi;	162	static struct CoroAPI coroapi;
160	static AV main_mainstack; / used to differentiate between $main and others */	163	static AV main_mainstack; / used to differentiate between $main and others */
161	static JMPENV *main_top_env;	164	static JMPENV *main_top_env;
162	static HV coro_state_stash, coro_stash;	165	static HV coro_state_stash, coro_stash;
…		…
361		364
362	/* casting is fun. */	365	/* casting is fun. */
363	while (&PL_sv_undef != (SV )(padlist = (AV )av_pop (av)))	366	while (&PL_sv_undef != (SV )(padlist = (AV )av_pop (av)))
364	free_padlist (aTHX_ padlist);	367	free_padlist (aTHX_ padlist);
365		368
		369	SvREFCNT_dec (av); /* sv_magicext increased the refcount */
		370
366	return 0;	371	return 0;
367	}	372	}
368		373
369	#define CORO_MAGIC_type_cv PERL_MAGIC_ext	374	#define CORO_MAGIC_type_cv PERL_MAGIC_ext
370	#define CORO_MAGIC_type_state PERL_MAGIC_ext	375	#define CORO_MAGIC_type_state PERL_MAGIC_ext
…		…
420	if (expect_true (mg && AvFILLp ((av = (AV *)mg->mg_obj)) >= 0))	425	if (expect_true (mg && AvFILLp ((av = (AV *)mg->mg_obj)) >= 0))
421	CvPADLIST (cv) = (AV *)AvARRAY (av)[AvFILLp (av)--];	426	CvPADLIST (cv) = (AV *)AvARRAY (av)[AvFILLp (av)--];
422	else	427	else
423	{	428	{
424	#if CORO_PREFER_PERL_FUNCTIONS	429	#if CORO_PREFER_PERL_FUNCTIONS
425	/* this is probably cleaner, but also slower? */	430	/* this is probably cleaner? but also slower! */
		431	/* in practise, it seems to be less stable */
426	CV *cp = Perl_cv_clone (cv);	432	CV *cp = Perl_cv_clone (cv);
427	CvPADLIST (cv) = CvPADLIST (cp);	433	CvPADLIST (cv) = CvPADLIST (cp);
428	CvPADLIST (cp) = 0;	434	CvPADLIST (cp) = 0;
429	SvREFCNT_dec (cp);	435	SvREFCNT_dec (cp);
430	#else	436	#else
…		…
663	#undef VAR	669	#undef VAR
664	}	670	}
665	else	671	else
666	slot = coro->slot;	672	slot = coro->slot;
667		673
		674	if (slot)
		675	{
668	rss += sizeof (slot->curstackinfo);	676	rss += sizeof (slot->curstackinfo);
669	rss += (slot->curstackinfo->si_cxmax + 1) * sizeof (PERL_CONTEXT);	677	rss += (slot->curstackinfo->si_cxmax + 1) * sizeof (PERL_CONTEXT);
670	rss += sizeof (SV) + sizeof (struct xpvav) + (1 + AvMAX (slot->curstack)) * sizeof (SV *);	678	rss += sizeof (SV) + sizeof (struct xpvav) + (1 + AvMAX (slot->curstack)) * sizeof (SV *);
671	rss += slot->tmps_max * sizeof (SV *);	679	rss += slot->tmps_max * sizeof (SV *);
672	rss += (slot->markstack_max - slot->markstack_ptr) * sizeof (I32);	680	rss += (slot->markstack_max - slot->markstack_ptr) * sizeof (I32);
673	rss += slot->scopestack_max * sizeof (I32);	681	rss += slot->scopestack_max * sizeof (I32);
674	rss += slot->savestack_max * sizeof (ANY);	682	rss += slot->savestack_max * sizeof (ANY);
675		683
676	#if !PERL_VERSION_ATLEAST (5,10,0)	684	#if !PERL_VERSION_ATLEAST (5,10,0)
677	rss += slot->retstack_max * sizeof (OP *);	685	rss += slot->retstack_max * sizeof (OP *);
678	#endif	686	#endif
		687	}
679	}	688	}
680		689
681	return rss;	690	return rss;
682	}	691	}
683		692
684	/ coroutine stack handling **********************************************/	693	/ coroutine stack handling **********************************************/
685		694
686	static int (orig_sigelem_get) (pTHX_ SV sv, MAGIC *mg);	695	static int (orig_sigelem_get) (pTHX_ SV sv, MAGIC *mg);
687	static int (orig_sigelem_set) (pTHX_ SV sv, MAGIC *mg);	696	static int (orig_sigelem_set) (pTHX_ SV sv, MAGIC *mg);
		697	static int (orig_sigelem_clr) (pTHX_ SV sv, MAGIC *mg);
		698
		699	/* apparently < 5.8.8 */
		700	#ifndef MgPV_nolen_const
		701	#define MgPV_nolen_const(mg) (((((int)(mg)->mg_len)) == HEf_SVKEY) ? \
		702	SvPV_nolen((SV*)((mg)->mg_ptr)) : \
		703	(const char*)(mg)->mg_ptr)
		704	#endif
688		705
689	/*	706	/*
690	* This overrides the default magic get method of %SIG elements.	707	* This overrides the default magic get method of %SIG elements.
691	* The original one doesn't provide for reading back of PL_diehook/PL_warnhook	708	* The original one doesn't provide for reading back of PL_diehook/PL_warnhook
692	* and instead of tryign to save and restore the hash elements, we just provide	709	* and instead of tryign to save and restore the hash elements, we just provide
…		…
700	{	717	{
701	const char *s = MgPV_nolen_const (mg);	718	const char *s = MgPV_nolen_const (mg);
702		719
703	if (*s == '_')	720	if (*s == '_')
704	{	721	{
705	if (strEQ (s, "__DIE__" ) && PL_diehook ) return sv_setsv (sv, PL_diehook ), 0;	722	SV **svp = 0;
706	if (strEQ (s, "__WARN__") && PL_warnhook) return sv_setsv (sv, PL_warnhook), 0;	723
		724	if (strEQ (s, "__DIE__" )) svp = &PL_diehook;
		725	if (strEQ (s, "__WARN__")) svp = &PL_warnhook;
		726
		727	if (svp)
		728	{
		729	sv_setsv (sv, svp ? svp : &PL_sv_undef);
		730	return 0;
		731	}
707	}	732	}
708		733
709	return orig_sigelem_get ? orig_sigelem_get (aTHX_ sv, mg) : 0;	734	return orig_sigelem_get ? orig_sigelem_get (aTHX_ sv, mg) : 0;
		735	}
		736
		737	static int
		738	coro_sigelem_clr (pTHX_ SV sv, MAGIC mg)
		739	{
		740	const char *s = MgPV_nolen_const (mg);
		741
		742	if (*s == '_')
		743	{
		744	SV **svp = 0;
		745
		746	if (strEQ (s, "__DIE__" )) svp = &PL_diehook;
		747	if (strEQ (s, "__WARN__")) svp = &PL_warnhook;
		748
		749	if (svp)
		750	{
		751	SV old = svp;
		752	*svp = 0;
		753	SvREFCNT_dec (old);
		754	return 0;
		755	}
		756	}
		757
		758	return orig_sigelem_clr ? orig_sigelem_clr (aTHX_ sv, mg) : 0;
710	}	759	}
711		760
712	static int	761	static int
713	coro_sigelem_set (pTHX_ SV sv, MAGIC mg)	762	coro_sigelem_set (pTHX_ SV sv, MAGIC mg)
714	{	763	{
…		…
1583	else	1632	else
1584	coro->slot->runops = RUNOPS_DEFAULT;	1633	coro->slot->runops = RUNOPS_DEFAULT;
1585	}	1634	}
1586	}	1635	}
1587		1636
		1637	static int
		1638	coro_gensub_free (pTHX_ SV sv, MAGIC mg)
		1639	{
		1640	AV *padlist;
		1641	AV av = (AV )mg->mg_obj;
		1642
		1643	abort ();
		1644
		1645	return 0;
		1646	}
		1647
		1648	static MGVTBL coro_gensub_vtbl = {
		1649	0, 0, 0, 0,
		1650	coro_gensub_free
		1651	};
		1652
		1653	/*****************************************************************************/
		1654	/* PerlIO::cede */
		1655
		1656	typedef struct
		1657	{
		1658	PerlIOBuf base;
		1659	NV next, every;
		1660	} PerlIOCede;
		1661
		1662	static IV
		1663	PerlIOCede_pushed (pTHX_ PerlIO f, const char mode, SV arg, PerlIO_funcs tab)
		1664	{
		1665	PerlIOCede *self = PerlIOSelf (f, PerlIOCede);
		1666
		1667	self->every = SvCUR (arg) ? SvNV (arg) : 0.01;
		1668	self->next = nvtime () + self->every;
		1669
		1670	return PerlIOBuf_pushed (aTHX_ f, mode, Nullsv, tab);
		1671	}
		1672
		1673	static SV *
		1674	PerlIOCede_getarg (pTHX_ PerlIO f, CLONE_PARAMS param, int flags)
		1675	{
		1676	PerlIOCede *self = PerlIOSelf (f, PerlIOCede);
		1677
		1678	return newSVnv (self->every);
		1679	}
		1680
		1681	static IV
		1682	PerlIOCede_flush (pTHX_ PerlIO *f)
		1683	{
		1684	PerlIOCede *self = PerlIOSelf (f, PerlIOCede);
		1685	double now = nvtime ();
		1686
		1687	if (now >= self->next)
		1688	{
		1689	api_cede ();
		1690	self->next = now + self->every;
		1691	}
		1692
		1693	return PerlIOBuf_flush (f);
		1694	}
		1695
		1696	static PerlIO_funcs PerlIO_cede =
		1697	{
		1698	sizeof(PerlIO_funcs),
		1699	"cede",
		1700	sizeof(PerlIOCede),
		1701	PERLIO_K_DESTRUCT \| PERLIO_K_RAW,
		1702	PerlIOCede_pushed,
		1703	PerlIOBuf_popped,
		1704	PerlIOBuf_open,
		1705	PerlIOBase_binmode,
		1706	PerlIOCede_getarg,
		1707	PerlIOBase_fileno,
		1708	PerlIOBuf_dup,
		1709	PerlIOBuf_read,
		1710	PerlIOBuf_unread,
		1711	PerlIOBuf_write,
		1712	PerlIOBuf_seek,
		1713	PerlIOBuf_tell,
		1714	PerlIOBuf_close,
		1715	PerlIOCede_flush,
		1716	PerlIOBuf_fill,
		1717	PerlIOBase_eof,
		1718	PerlIOBase_error,
		1719	PerlIOBase_clearerr,
		1720	PerlIOBase_setlinebuf,
		1721	PerlIOBuf_get_base,
		1722	PerlIOBuf_bufsiz,
		1723	PerlIOBuf_get_ptr,
		1724	PerlIOBuf_get_cnt,
		1725	PerlIOBuf_set_ptrcnt,
		1726	};
		1727
		1728
1588	MODULE = Coro::State PACKAGE = Coro::State PREFIX = api_	1729	MODULE = Coro::State PACKAGE = Coro::State PREFIX = api_
1589		1730
1590	PROTOTYPES: DISABLE	1731	PROTOTYPES: DISABLE
1591		1732
1592	BOOT:	1733	BOOT:
…		…
1597	BOOT_PAGESIZE;	1738	BOOT_PAGESIZE;
1598		1739
1599	irsgv = gv_fetchpv ("/" , GV_ADD\|GV_NOTQUAL, SVt_PV);	1740	irsgv = gv_fetchpv ("/" , GV_ADD\|GV_NOTQUAL, SVt_PV);
1600	stdoutgv = gv_fetchpv ("STDOUT", GV_ADD\|GV_NOTQUAL, SVt_PVIO);	1741	stdoutgv = gv_fetchpv ("STDOUT", GV_ADD\|GV_NOTQUAL, SVt_PVIO);
1601		1742
1602	orig_sigelem_get = PL_vtbl_sigelem.svt_get;	1743	orig_sigelem_get = PL_vtbl_sigelem.svt_get; PL_vtbl_sigelem.svt_get = coro_sigelem_get;
1603	PL_vtbl_sigelem.svt_get = coro_sigelem_get;	1744	orig_sigelem_set = PL_vtbl_sigelem.svt_set; PL_vtbl_sigelem.svt_set = coro_sigelem_set;
1604	orig_sigelem_set = PL_vtbl_sigelem.svt_set;	1745	orig_sigelem_clr = PL_vtbl_sigelem.svt_clear; PL_vtbl_sigelem.svt_clear = coro_sigelem_clr;
1605	PL_vtbl_sigelem.svt_set = coro_sigelem_set;
1606		1746
1607	hv_sig = coro_get_hv (aTHX_ "SIG", TRUE);	1747	hv_sig = coro_get_hv (aTHX_ "SIG", TRUE);
1608	rv_diehook = newRV_inc ((SV *)gv_fetchpv ("Coro::State::diehook" , 0, SVt_PVCV));	1748	rv_diehook = newRV_inc ((SV *)gv_fetchpv ("Coro::State::diehook" , 0, SVt_PVCV));
1609	rv_warnhook = newRV_inc ((SV *)gv_fetchpv ("Coro::State::warnhook", 0, SVt_PVCV));	1749	rv_warnhook = newRV_inc ((SV *)gv_fetchpv ("Coro::State::warnhook", 0, SVt_PVCV));
1610		1750
…		…
1622	main_top_env = main_top_env->je_prev;	1762	main_top_env = main_top_env->je_prev;
1623		1763
1624	coroapi.ver = CORO_API_VERSION;	1764	coroapi.ver = CORO_API_VERSION;
1625	coroapi.rev = CORO_API_REVISION;	1765	coroapi.rev = CORO_API_REVISION;
1626	coroapi.transfer = api_transfer;	1766	coroapi.transfer = api_transfer;
		1767
		1768	{
		1769	SV **svp = hv_fetch (PL_modglobal, "Time::NVtime", 12, 0);
		1770
		1771	if (!svp) croak ("Time::HiRes is required");
		1772	if (!SvIOK (*svp)) croak ("Time::NVtime isn't a function pointer");
		1773
		1774	nvtime = INT2PTR (double ()(), SvIV (svp));
		1775	}
1627		1776
1628	assert (("PRIO_NORMAL must be 0", !PRIO_NORMAL));	1777	assert (("PRIO_NORMAL must be 0", !PRIO_NORMAL));
1629	}	1778	}
1630		1779
1631	SV *	1780	SV *
…		…
1759	call (Coro::State coro, SV *coderef)	1908	call (Coro::State coro, SV *coderef)
1760	ALIAS:	1909	ALIAS:
1761	eval = 1	1910	eval = 1
1762	CODE:	1911	CODE:
1763	{	1912	{
1764	if (coro->mainstack)	1913	if (coro->mainstack && ((coro->flags & CF_RUNNING) \|\| coro->slot))
1765	{	1914	{
1766	struct coro temp;	1915	struct coro temp;
1767		1916
1768	if (!(coro->flags & CF_RUNNING))	1917	if (!(coro->flags & CF_RUNNING))
1769	{	1918	{
…		…
1851	force_cctx ()	2000	force_cctx ()
1852	CODE:	2001	CODE:
1853	struct coro *coro = SvSTATE (coro_current);	2002	struct coro *coro = SvSTATE (coro_current);
1854	coro->cctx->idle_sp = 0;	2003	coro->cctx->idle_sp = 0;
1855		2004
1856	MODULE = Coro::State PACKAGE = Coro
1857
1858	BOOT:
1859	{
1860	int i;
1861
1862	av_async_pool = coro_get_av (aTHX_ "Coro::async_pool", TRUE);
1863	sv_pool_rss = coro_get_sv (aTHX_ "Coro::POOL_RSS" , TRUE);
1864	sv_pool_size = coro_get_sv (aTHX_ "Coro::POOL_SIZE" , TRUE);
1865
1866	coro_current = coro_get_sv (aTHX_ "Coro::current", FALSE);
1867	SvREADONLY_on (coro_current);
1868
1869	coro_stash = gv_stashpv ("Coro", TRUE);
1870
1871	newCONSTSUB (coro_stash, "PRIO_MAX", newSViv (PRIO_MAX));
1872	newCONSTSUB (coro_stash, "PRIO_HIGH", newSViv (PRIO_HIGH));
1873	newCONSTSUB (coro_stash, "PRIO_NORMAL", newSViv (PRIO_NORMAL));
1874	newCONSTSUB (coro_stash, "PRIO_LOW", newSViv (PRIO_LOW));
1875	newCONSTSUB (coro_stash, "PRIO_IDLE", newSViv (PRIO_IDLE));
1876	newCONSTSUB (coro_stash, "PRIO_MIN", newSViv (PRIO_MIN));
1877
1878	for (i = PRIO_MAX - PRIO_MIN + 1; i--; )
1879	coro_ready[i] = newAV ();
1880
1881	{
1882	SV *sv = perl_get_sv ("Coro::API", TRUE);
1883	perl_get_sv ("Coro::API", TRUE); /* silence 5.10 warning */
1884
1885	coroapi.schedule = api_schedule;
1886	coroapi.cede = api_cede;
1887	coroapi.cede_notself = api_cede_notself;
1888	coroapi.ready = api_ready;
1889	coroapi.is_ready = api_is_ready;
1890	coroapi.nready = &coro_nready;
1891	coroapi.current = coro_current;
1892
1893	GCoroAPI = &coroapi;
1894	sv_setiv (sv, (IV)&coroapi);
1895	SvREADONLY_on (sv);
1896	}
1897	}
1898
1899	void
1900	_set_current (SV *current)
1901	PROTOTYPE: $
1902	CODE:
1903	SvREFCNT_dec (SvRV (coro_current));
1904	SvRV_set (coro_current, SvREFCNT_inc (SvRV (current)));
1905
1906	void
1907	_set_readyhook (SV *hook)
1908	PROTOTYPE: $
1909	CODE:
1910	LOCK;
1911	SvREFCNT_dec (coro_readyhook);
1912	coro_readyhook = SvOK (hook) ? newSVsv (hook) : 0;
1913	UNLOCK;
1914
1915	int
1916	prio (Coro::State coro, int newprio = 0)
1917	ALIAS:
1918	nice = 1
1919	CODE:
1920	{
1921	RETVAL = coro->prio;
1922
1923	if (items > 1)
1924	{
1925	if (ix)
1926	newprio = coro->prio - newprio;
1927
1928	if (newprio < PRIO_MIN) newprio = PRIO_MIN;
1929	if (newprio > PRIO_MAX) newprio = PRIO_MAX;
1930
1931	coro->prio = newprio;
1932	}
1933	}
1934	OUTPUT:
1935	RETVAL
1936
1937	SV *
1938	ready (SV *self)
1939	PROTOTYPE: $
1940	CODE:
1941	RETVAL = boolSV (api_ready (self));
1942	OUTPUT:
1943	RETVAL
1944
1945	int
1946	nready (...)
1947	PROTOTYPE:
1948	CODE:
1949	RETVAL = coro_nready;
1950	OUTPUT:
1951	RETVAL
1952
1953	void	2005	void
1954	throw (Coro::State self, SV *throw = &PL_sv_undef)	2006	throw (Coro::State self, SV *throw = &PL_sv_undef)
1955	PROTOTYPE: $;$	2007	PROTOTYPE: $;$
1956	CODE:	2008	CODE:
1957	SvREFCNT_dec (self->throw);	2009	SvREFCNT_dec (self->throw);
…		…
1971	SV dst = ix ? (SV )&self->slot->defav : (SV **)&self->slot->defsv;	2023	SV dst = ix ? (SV )&self->slot->defav : (SV **)&self->slot->defsv;
1972		2024
1973	SV tmp = src; src = dst; *dst = tmp;	2025	SV tmp = src; src = dst; *dst = tmp;
1974	}	2026	}
1975		2027
		2028	MODULE = Coro::State PACKAGE = Coro
		2029
		2030	BOOT:
		2031	{
		2032	int i;
		2033
		2034	av_async_pool = coro_get_av (aTHX_ "Coro::async_pool", TRUE);
		2035	sv_pool_rss = coro_get_sv (aTHX_ "Coro::POOL_RSS" , TRUE);
		2036	sv_pool_size = coro_get_sv (aTHX_ "Coro::POOL_SIZE" , TRUE);
		2037
		2038	coro_current = coro_get_sv (aTHX_ "Coro::current", FALSE);
		2039	SvREADONLY_on (coro_current);
		2040
		2041	coro_stash = gv_stashpv ("Coro", TRUE);
		2042
		2043	newCONSTSUB (coro_stash, "PRIO_MAX", newSViv (PRIO_MAX));
		2044	newCONSTSUB (coro_stash, "PRIO_HIGH", newSViv (PRIO_HIGH));
		2045	newCONSTSUB (coro_stash, "PRIO_NORMAL", newSViv (PRIO_NORMAL));
		2046	newCONSTSUB (coro_stash, "PRIO_LOW", newSViv (PRIO_LOW));
		2047	newCONSTSUB (coro_stash, "PRIO_IDLE", newSViv (PRIO_IDLE));
		2048	newCONSTSUB (coro_stash, "PRIO_MIN", newSViv (PRIO_MIN));
		2049
		2050	for (i = PRIO_MAX - PRIO_MIN + 1; i--; )
		2051	coro_ready[i] = newAV ();
		2052
		2053	{
		2054	SV *sv = perl_get_sv ("Coro::API", TRUE);
		2055	perl_get_sv ("Coro::API", TRUE); /* silence 5.10 warning */
		2056
		2057	coroapi.schedule = api_schedule;
		2058	coroapi.cede = api_cede;
		2059	coroapi.cede_notself = api_cede_notself;
		2060	coroapi.ready = api_ready;
		2061	coroapi.is_ready = api_is_ready;
		2062	coroapi.nready = &coro_nready;
		2063	coroapi.current = coro_current;
		2064
		2065	GCoroAPI = &coroapi;
		2066	sv_setiv (sv, (IV)&coroapi);
		2067	SvREADONLY_on (sv);
		2068	}
		2069	}
		2070
		2071	void
		2072	_set_current (SV *current)
		2073	PROTOTYPE: $
		2074	CODE:
		2075	SvREFCNT_dec (SvRV (coro_current));
		2076	SvRV_set (coro_current, SvREFCNT_inc (SvRV (current)));
		2077
		2078	void
		2079	_set_readyhook (SV *hook)
		2080	PROTOTYPE: $
		2081	CODE:
		2082	LOCK;
		2083	SvREFCNT_dec (coro_readyhook);
		2084	coro_readyhook = SvOK (hook) ? newSVsv (hook) : 0;
		2085	UNLOCK;
		2086
		2087	int
		2088	prio (Coro::State coro, int newprio = 0)
		2089	ALIAS:
		2090	nice = 1
		2091	CODE:
		2092	{
		2093	RETVAL = coro->prio;
		2094
		2095	if (items > 1)
		2096	{
		2097	if (ix)
		2098	newprio = coro->prio - newprio;
		2099
		2100	if (newprio < PRIO_MIN) newprio = PRIO_MIN;
		2101	if (newprio > PRIO_MAX) newprio = PRIO_MAX;
		2102
		2103	coro->prio = newprio;
		2104	}
		2105	}
		2106	OUTPUT:
		2107	RETVAL
		2108
		2109	SV *
		2110	ready (SV *self)
		2111	PROTOTYPE: $
		2112	CODE:
		2113	RETVAL = boolSV (api_ready (self));
		2114	OUTPUT:
		2115	RETVAL
		2116
		2117	int
		2118	nready (...)
		2119	PROTOTYPE:
		2120	CODE:
		2121	RETVAL = coro_nready;
		2122	OUTPUT:
		2123	RETVAL
		2124
1976	# for async_pool speedup	2125	# for async_pool speedup
1977	void	2126	void
1978	_pool_1 (SV *cb)	2127	_pool_1 (SV *cb)
1979	CODE:	2128	CODE:
1980	{	2129	{
…		…
1985	AV *invoke_av;	2134	AV *invoke_av;
1986	int i, len;	2135	int i, len;
1987		2136
1988	if (!invoke)	2137	if (!invoke)
1989	{	2138	{
1990	SvREFCNT_dec (PL_diehook); PL_diehook = 0;	2139	SV *old = PL_diehook;
		2140	PL_diehook = 0;
		2141	SvREFCNT_dec (old);
1991	croak ("\3async_pool terminate\2\n");	2142	croak ("\3async_pool terminate\2\n");
1992	}	2143	}
1993		2144
1994	SvREFCNT_dec (coro->saved_deffh);	2145	SvREFCNT_dec (coro->saved_deffh);
1995	coro->saved_deffh = SvREFCNT_inc ((SV *)PL_defoutgv);	2146	coro->saved_deffh = SvREFCNT_inc ((SV *)PL_defoutgv);
…		…
2024	coro->saved_deffh = 0;	2175	coro->saved_deffh = 0;
2025		2176
2026	if (coro_rss (aTHX_ coro) > SvIV (sv_pool_rss)	2177	if (coro_rss (aTHX_ coro) > SvIV (sv_pool_rss)
2027	\|\| av_len (av_async_pool) + 1 >= SvIV (sv_pool_size))	2178	\|\| av_len (av_async_pool) + 1 >= SvIV (sv_pool_size))
2028	{	2179	{
2029	SvREFCNT_dec (PL_diehook); PL_diehook = 0;	2180	SV *old = PL_diehook;
		2181	PL_diehook = 0;
		2182	SvREFCNT_dec (old);
2030	croak ("\3async_pool terminate\2\n");	2183	croak ("\3async_pool terminate\2\n");
2031	}	2184	}
2032		2185
2033	av_clear (GvAV (PL_defgv));	2186	av_clear (GvAV (PL_defgv));
2034	hv_store ((HV *)SvRV (coro_current), "desc", sizeof ("desc") - 1,	2187	hv_store ((HV *)SvRV (coro_current), "desc", sizeof ("desc") - 1,
…		…
2039	if (coro->cctx && (coro->cctx->flags & CC_TRACE))	2192	if (coro->cctx && (coro->cctx->flags & CC_TRACE))
2040	api_trace (coro_current, 0);	2193	api_trace (coro_current, 0);
2041		2194
2042	av_push (av_async_pool, newSVsv (coro_current));	2195	av_push (av_async_pool, newSVsv (coro_current));
2043	}	2196	}
		2197
		2198	#if 0
		2199
		2200	void
		2201	_generator_call (...)
		2202	PROTOTYPE: @
		2203	PPCODE:
		2204	fprintf (stderr, "call %p\n", CvXSUBANY(cv).any_ptr);
		2205	xxxx
		2206	abort ();
		2207
		2208	SV *
		2209	gensub (SV *sub, ...)
		2210	PROTOTYPE: &;@
		2211	CODE:
		2212	{
		2213	struct coro *coro;
		2214	MAGIC *mg;
		2215	CV *xcv;
		2216	CV ncv = (CV )newSV_type (SVt_PVCV);
		2217	int i;
		2218
		2219	CvGV (ncv) = CvGV (cv);
		2220	CvFILE (ncv) = CvFILE (cv);
		2221
		2222	Newz (0, coro, 1, struct coro);
		2223	coro->args = newAV ();
		2224	coro->flags = CF_NEW;
		2225
		2226	av_extend (coro->args, items - 1);
		2227	for (i = 1; i < items; i++)
		2228	av_push (coro->args, newSVsv (ST (i)));
		2229
		2230	CvISXSUB_on (ncv);
		2231	CvXSUBANY (ncv).any_ptr = (void *)coro;
		2232
		2233	xcv = GvCV (gv_fetchpv ("Coro::_generator_call", 0, SVt_PVCV));
		2234
		2235	CvXSUB (ncv) = CvXSUB (xcv);
		2236	CvANON_on (ncv);
		2237
		2238	mg = sv_magicext ((SV )ncv, 0, CORO_MAGIC_type_state, &coro_gensub_vtbl, (char )coro, 0);
		2239	RETVAL = newRV_noinc ((SV *)ncv);
		2240	}
		2241	OUTPUT:
		2242	RETVAL
		2243
		2244	#endif
2044		2245
2045		2246
2046	MODULE = Coro::State PACKAGE = Coro::AIO	2247	MODULE = Coro::State PACKAGE = Coro::AIO
2047		2248
2048	SV *	2249	SV *
…		…
2106	}	2307	}
2107		2308
2108	--incede;	2309	--incede;
2109	}	2310	}
2110		2311
		2312
		2313	MODULE = Coro::State PACKAGE = PerlIO::cede
		2314
		2315	BOOT:
		2316	PerlIO_define_layer (aTHX_ &PerlIO_cede);

Diff Legend

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

Comparing Coro/Coro/State.xs (file contents): Revision 1.237 by root, Fri May 23 00:27:06 2008 UTC vs. Revision 1.247 by root, Wed Sep 24 21:31:29 2008 UTC

Diff Legend

Comparing Coro/Coro/State.xs (file contents):
Revision 1.237 by root, Fri May 23 00:27:06 2008 UTC vs.
Revision 1.247 by root, Wed Sep 24 21:31:29 2008 UTC