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

Comparing Coro/Coro/State.xs (file contents):
Revision 1.266 by root, Fri Nov 14 03:26:22 2008 UTC vs.
Revision 1.272 by root, Fri Nov 14 20:35:49 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)
…		…
180	static JMPENV *main_top_env;	183	static JMPENV *main_top_env;
181	static HV coro_state_stash, coro_stash;	184	static HV coro_state_stash, coro_stash;
182	static volatile SV coro_mortal; / will be freed/thrown after next transfer */	185	static volatile SV coro_mortal; / will be freed/thrown after next transfer */
183	static volatile struct coro *transfer_next;	186	static volatile struct coro *transfer_next;
184		187
185	struct transfer_args
186	{
187	struct coro prev, next;
188	};
189
190	static GV irsgv; / $/ */	188	static GV irsgv; / $/ */
191	static GV stdoutgv; / STDOUT /	189	static GV stdoutgv; / STDOUT /
192	static SV *rv_diehook;	190	static SV *rv_diehook;
193	static SV *rv_warnhook;	191	static SV *rv_warnhook;
194	static HV hv_sig; / %SIG */	192	static HV hv_sig; / %SIG */
…		…
212	CC_TRACE_LINE = 0x10, /* trace each statement */	210	CC_TRACE_LINE = 0x10, /* trace each statement */
213	CC_TRACE_ALL = CC_TRACE_SUB \| CC_TRACE_LINE,	211	CC_TRACE_ALL = CC_TRACE_SUB \| CC_TRACE_LINE,
214	};	212	};
215		213
216	/* this is a structure representing a c-level coroutine */	214	/* this is a structure representing a c-level coroutine */
217	typedef struct coro_cctx {	215	typedef struct coro_cctx
		216	{
218	struct coro_cctx *next;	217	struct coro_cctx *next;
219		218
220	/* the stack */	219	/* the stack */
221	void *sptr;	220	void *sptr;
222	size_t ssize;	221	size_t ssize;
…		…
240	CF_NEW = 0x0004, /* has never been switched to */	239	CF_NEW = 0x0004, /* has never been switched to */
241	CF_DESTROYED = 0x0008, /* coroutine data has been freed */	240	CF_DESTROYED = 0x0008, /* coroutine data has been freed */
242	};	241	};
243		242
244	/* the structure where most of the perl state is stored, overlaid on the cxstack */	243	/* the structure where most of the perl state is stored, overlaid on the cxstack */
245	typedef struct {	244	typedef struct
		245	{
246	SV *defsv;	246	SV *defsv;
247	AV *defav;	247	AV *defav;
248	SV *errsv;	248	SV *errsv;
249	SV *irsgv;	249	SV *irsgv;
250	#define VAR(name,type) type name;	250	#define VAR(name,type) type name;
…		…
252	#undef VAR	252	#undef VAR
253	} perl_slots;	253	} perl_slots;
254		254
255	#define SLOT_COUNT ((sizeof (perl_slots) + sizeof (PERL_CONTEXT) - 1) / sizeof (PERL_CONTEXT))	255	#define SLOT_COUNT ((sizeof (perl_slots) + sizeof (PERL_CONTEXT) - 1) / sizeof (PERL_CONTEXT))
256		256
		257	/* this is the per-perl-coro slf frame info */
		258	/* it is treated like other "global" interpreter data */
		259	/* and unfortunately is copied around, so kepe it small */
		260	struct slf_frame
		261	{
		262	void (prepare) (struct coro_transfer_args ta); /* 0 means not yet initialised */
		263	int (*check) (pTHX);
		264	};
		265
257	/* this is a structure representing a perl-level coroutine */	266	/* this is a structure representing a perl-level coroutine */
258	struct coro {	267	struct coro {
259	/* the c coroutine allocated to this perl coroutine, if any */	268	/* the C coroutine allocated to this perl coroutine, if any */
260	coro_cctx *cctx;	269	coro_cctx *cctx;
261		270
262	/* process data */	271	/* process data */
		272	struct slf_frame slf_frame; /* saved slf frame */
		273	void *slf_data;
263	AV *mainstack;	274	AV *mainstack;
264	perl_slots slot; / basically the saved sp */	275	perl_slots slot; / basically the saved sp */
265		276
266	AV args; / data associated with this coroutine (initial args) */	277	AV args; / data associated with this coroutine (initial args) */
267	int refcnt; /* coroutines are refcounted, yes */	278	int refcnt; /* coroutines are refcounted, yes */
…		…
282	struct coro next, prev;	293	struct coro next, prev;
283	};	294	};
284		295
285	typedef struct coro *Coro__State;	296	typedef struct coro *Coro__State;
286	typedef struct coro *Coro__State_or_hashref;	297	typedef struct coro *Coro__State_or_hashref;
		298
		299	static struct slf_frame slf_frame; /* the current slf frame */
287		300
288	/ Coro ******************************************************************/	301	/ Coro ******************************************************************/
289		302
290	#define PRIO_MAX 3	303	#define PRIO_MAX 3
291	#define PRIO_HIGH 1	304	#define PRIO_HIGH 1
…		…
296		309
297	/* for Coro.pm */	310	/* for Coro.pm */
298	static SV *coro_current;	311	static SV *coro_current;
299	static SV *coro_readyhook;	312	static SV *coro_readyhook;
300	static AV *coro_ready [PRIO_MAX - PRIO_MIN + 1];	313	static AV *coro_ready [PRIO_MAX - PRIO_MIN + 1];
301	static int coro_nready;
302	static struct coro *coro_first;	314	static struct coro *coro_first;
		315	#define coro_nready coroapi.nready
303		316
304	/ lowlevel stuff ********************************************************/	317	/ lowlevel stuff ********************************************************/
305		318
306	static SV *	319	static SV *
307	coro_get_sv (pTHX_ const char *name, int create)	320	coro_get_sv (pTHX_ const char *name, int create)
…		…
511	CvPADLIST (cv) = (AV *)POPs;	524	CvPADLIST (cv) = (AV *)POPs;
512	}	525	}
513		526
514	PUTBACK;	527	PUTBACK;
515	}	528	}
		529
		530	slf_frame = c->slf_frame;
		531	coroapi.slf_data = c->slf_data;
516	}	532	}
517		533
518	static void	534	static void
519	save_perl (pTHX_ Coro__State c)	535	save_perl (pTHX_ Coro__State c)
520	{	536	{
		537	c->slf_data = coroapi.slf_data;
		538	c->slf_frame = slf_frame;
		539
521	{	540	{
522	dSP;	541	dSP;
523	I32 cxix = cxstack_ix;	542	I32 cxix = cxstack_ix;
524	PERL_CONTEXT *ccstk = cxstack;	543	PERL_CONTEXT *ccstk = cxstack;
525	PERL_SI *top_si = PL_curstackinfo;	544	PERL_SI *top_si = PL_curstackinfo;
…		…
592	#undef VAR	611	#undef VAR
593	}	612	}
594	}	613	}
595		614
596	/*	615	/*
597	* allocate various perl stacks. This is an exact copy	616	* allocate various perl stacks. This is almost an exact copy
598	* of perl.c:init_stacks, except that it uses less memory	617	* of perl.c:init_stacks, except that it uses less memory
599	* on the (sometimes correct) assumption that coroutines do	618	* on the (sometimes correct) assumption that coroutines do
600	* not usually need a lot of stackspace.	619	* not usually need a lot of stackspace.
601	*/	620	*/
602	#if CORO_PREFER_PERL_FUNCTIONS	621	#if CORO_PREFER_PERL_FUNCTIONS
…		…
709	#endif	728	#endif
710	}	729	}
711	}	730	}
712		731
713	return rss;	732	return rss;
714	}
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
723	INLINE void
724	set_stacklevel_tail (pTHX)
725	{
726	dSP;
727	SV **bot = SP;
728
729	int gimme = GIMME_V;
730
731	/* make sure we put something on the stack in scalar context */
732	if (gimme == G_SCALAR)
733	{
734	if (sp == bot)
735	XPUSHs (&PL_sv_undef);
736
737	SP = bot + 1;
738	}
739
740	PUTBACK;
741	}	733	}
742		734
743	/ coroutine stack handling **********************************************/	735	/ coroutine stack handling **********************************************/
744		736
745	static int (orig_sigelem_get) (pTHX_ SV sv, MAGIC *mg);	737	static int (orig_sigelem_get) (pTHX_ SV sv, MAGIC *mg);
…		…
831		823
832	return orig_sigelem_set ? orig_sigelem_set (aTHX_ sv, mg) : 0;	824	return orig_sigelem_set ? orig_sigelem_set (aTHX_ sv, mg) : 0;
833	}	825	}
834		826
835	static void	827	static void
		828	prepare_nop (aTHX_ struct coro_transfer_args *ta)
		829	{
		830	/* kind of mega-hacky, but works */
		831	ta->next = ta->prev = (struct coro *)ta;
		832	}
		833
		834	static int
		835	slf_check_nop (aTHX)
		836	{
		837	return 0;
		838	}
		839
		840	static void
836	coro_setup (pTHX_ struct coro *coro)	841	coro_setup (pTHX_ struct coro *coro)
837	{	842	{
838	/*	843	/*
839	* emulate part of the perl startup here.	844	* emulate part of the perl startup here.
840	*/	845	*/
…		…
879	PL_op = PL_ppaddr[OP_ENTERSUB](aTHX);	884	PL_op = PL_ppaddr[OP_ENTERSUB](aTHX);
880	SPAGAIN;	885	SPAGAIN;
881	}	886	}
882		887
883	/* this newly created coroutine might be run on an existing cctx which most	888	/* this newly created coroutine might be run on an existing cctx which most
884	* likely was suspended in set_stacklevel, called from pp_set_stacklevel,	889	* likely was suspended in pp_slf, so we have to emulate entering pp_slf here.
885	* so we have to emulate entering pp_set_stacklevel here.
886	*/	890	*/
887	SSL_HEAD;	891	slf_frame.prepare = prepare_nop; /* provide a nop function for an eventual pp_slf */
		892	slf_frame.check = slf_check_nop; /* signal pp_slf to not repeat */
888	}	893	}
889		894
890	static void	895	static void
891	coro_destruct (pTHX_ struct coro *coro)	896	coro_destruct (pTHX_ struct coro *coro)
892	{	897	{
…		…
1056	TAINT_NOT;	1061	TAINT_NOT;
1057	return 0;	1062	return 0;
1058	}	1063	}
1059		1064
1060	static void	1065	static void
1061	prepare_set_stacklevel (struct transfer_args ta, struct coro_cctx cctx)	1066	prepare_set_stacklevel (struct coro_transfer_args ta, struct coro_cctx cctx)
1062	{	1067	{
1063	ta->prev = (struct coro *)cctx;	1068	ta->prev = (struct coro *)cctx;
1064	ta->next = 0;	1069	ta->next = 0;
1065	}	1070	}
1066		1071
…		…
1126	# endif	1131	# endif
1127	#endif	1132	#endif
1128	{	1133	{
1129	dTHX;	1134	dTHX;
1130		1135
1131	/* we are the alternative tail to pp_set_stacklevel */	1136	/* normally we would need to skip the entersub here */
1132	/* so do the same things here */	1137	/* not doing so will re-execute it, which is exactly what we want */
1133	SSL_TAIL;
1134
1135	/* we now skip the op that did lead to transfer() */
1136	PL_op = PL_op->op_next;	1138	/* PL_nop = PL_nop->op_next */
1137		1139
1138	/* inject a fake subroutine call to cctx_init */	1140	/* inject a fake subroutine call to cctx_init */
1139	cctx_prepare (aTHX_ (coro_cctx *)arg);	1141	cctx_prepare (aTHX_ (coro_cctx *)arg);
1140		1142
1141	/* cctx_run is the alternative tail of transfer() */	1143	/* cctx_run is the alternative tail of transfer() */
		1144	/* TODO: throwing an exception here might be deadly, VERIFY */
1142	transfer_tail (aTHX);	1145	transfer_tail (aTHX);
1143		1146
1144	/* somebody or something will hit me for both perl_run and PL_restartop */	1147	/* somebody or something will hit me for both perl_run and PL_restartop */
1145	PL_restartop = PL_op;	1148	PL_restartop = PL_op;
1146	perl_run (PL_curinterp);	1149	perl_run (PL_curinterp);
…		…
1329	dSTACKLEVEL;	1332	dSTACKLEVEL;
1330		1333
1331	/* sometimes transfer is only called to set idle_sp */	1334	/* sometimes transfer is only called to set idle_sp */
1332	if (expect_false (!next))	1335	if (expect_false (!next))
1333	{	1336	{
1334	((coro_cctx *)prev)->idle_sp = STACKLEVEL;	1337	((coro_cctx *)prev)->idle_sp = stacklevel;
1335	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 */
1336	}	1339	}
1337	else if (expect_true (prev != next))	1340	else if (expect_true (prev != next))
1338	{	1341	{
1339	coro_cctx *prev__cctx;	1342	coro_cctx *prev__cctx;
…		…
1366		1369
1367	prev__cctx = prev->cctx;	1370	prev__cctx = prev->cctx;
1368		1371
1369	/* possibly untie and reuse the cctx */	1372	/* possibly untie and reuse the cctx */
1370	if (expect_true (	1373	if (expect_true (
1371	prev__cctx->idle_sp == STACKLEVEL	1374	prev__cctx->idle_sp == stacklevel
1372	&& !(prev__cctx->flags & CC_TRACE)	1375	&& !(prev__cctx->flags & CC_TRACE)
1373	&& !force_cctx	1376	&& !force_cctx
1374	))	1377	))
1375	{	1378	{
1376	/* 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 */
1377	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));
1378		1381
1379	prev->cctx = 0;	1382	prev->cctx = 0;
1380		1383
1381	/* 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 */
…		…
1494	# define MGf_DUP 0	1497	# define MGf_DUP 0
1495	#endif	1498	#endif
1496	};	1499	};
1497		1500
1498	static void	1501	static void
1499	prepare_transfer (pTHX_ struct transfer_args ta, SV prev_sv, SV *next_sv)	1502	prepare_transfer (pTHX_ struct coro_transfer_args ta, SV prev_sv, SV *next_sv)
1500	{	1503	{
1501	ta->prev = SvSTATE (prev_sv);	1504	ta->prev = SvSTATE (prev_sv);
1502	ta->next = SvSTATE (next_sv);	1505	ta->next = SvSTATE (next_sv);
1503	TRANSFER_CHECK (*ta);	1506	TRANSFER_CHECK (*ta);
1504	}	1507	}
1505		1508
1506	static void	1509	static void
1507	api_transfer (SV prev_sv, SV next_sv)	1510	api_transfer (pTHX_ SV prev_sv, SV next_sv)
1508	{	1511	{
1509	dTHX;
1510	struct transfer_args ta;	1512	struct coro_transfer_args ta;
1511		1513
1512	prepare_transfer (aTHX_ &ta, prev_sv, next_sv);	1514	prepare_transfer (aTHX_ &ta, prev_sv, next_sv);
1513	TRANSFER (ta, 1);	1515	TRANSFER (ta, 1);
1514	}	1516	}
1515		1517
…		…
1532		1534
1533	return 0;	1535	return 0;
1534	}	1536	}
1535		1537
1536	static int	1538	static int
1537	api_ready (SV *coro_sv)	1539	api_ready (pTHX_ SV *coro_sv)
1538	{	1540	{
1539	dTHX;
1540	struct coro *coro;	1541	struct coro *coro;
1541	SV *sv_hook;	1542	SV *sv_hook;
1542	void (*xs_hook)(void);	1543	void (*xs_hook)(void);
1543		1544
1544	if (SvROK (coro_sv))	1545	if (SvROK (coro_sv))
…		…
1582		1583
1583	return 1;	1584	return 1;
1584	}	1585	}
1585		1586
1586	static int	1587	static int
1587	api_is_ready (SV *coro_sv)	1588	api_is_ready (pTHX_ SV *coro_sv)
1588	{	1589	{
1589	dTHX;
1590
1591	return !!(SvSTATE (coro_sv)->flags & CF_READY);	1590	return !!(SvSTATE (coro_sv)->flags & CF_READY);
1592	}	1591	}
1593		1592
1594	INLINE void	1593	INLINE void
1595	prepare_schedule (pTHX_ struct transfer_args *ta)	1594	prepare_schedule (pTHX_ struct coro_transfer_args *ta)
1596	{	1595	{
1597	SV prev_sv, next_sv;	1596	SV prev_sv, next_sv;
1598		1597
1599	for (;;)	1598	for (;;)
1600	{	1599	{
…		…
1649	coro_mortal = prev_sv;	1648	coro_mortal = prev_sv;
1650	UNLOCK;	1649	UNLOCK;
1651	}	1650	}
1652		1651
1653	INLINE void	1652	INLINE void
1654	prepare_cede (pTHX_ struct transfer_args *ta)	1653	prepare_cede (pTHX_ struct coro_transfer_args *ta)
1655	{	1654	{
1656	api_ready (coro_current);	1655	api_ready (aTHX_ coro_current);
1657	prepare_schedule (aTHX_ ta);	1656	prepare_schedule (aTHX_ ta);
1658	}	1657	}
1659		1658
		1659	INLINE void
		1660	prepare_cede_notself (pTHX_ struct coro_transfer_args *ta)
		1661	{
		1662	SV *prev = SvRV (coro_current);
		1663
		1664	if (coro_nready)
		1665	{
		1666	prepare_schedule (aTHX_ ta);
		1667	api_ready (aTHX_ prev);
		1668	}
		1669	else
		1670	prepare_nop (aTHX_ ta);
		1671	}
		1672
		1673	static void
		1674	api_schedule (pTHX)
		1675	{
		1676	struct coro_transfer_args ta;
		1677
		1678	prepare_schedule (aTHX_ &ta);
		1679	TRANSFER (ta, 1);
		1680	}
		1681
1660	static int	1682	static int
1661	prepare_cede_notself (pTHX_ struct transfer_args *ta)	1683	api_cede (pTHX)
1662	{	1684	{
1663	if (coro_nready)	1685	struct coro_transfer_args ta;
1664	{	1686
1665	SV *prev = SvRV (coro_current);
1666	prepare_schedule (aTHX_ ta);	1687	prepare_cede (aTHX_ &ta);
1667	api_ready (prev);	1688
		1689	if (expect_true (ta.prev != ta.next))
		1690	{
		1691	TRANSFER (ta, 1);
1668	return 1;	1692	return 1;
1669	}	1693	}
1670	else	1694	else
1671	return 0;	1695	return 0;
1672	}	1696	}
1673		1697
1674	static void
1675	api_schedule (void)
1676	{
1677	dTHX;
1678	struct transfer_args ta;
1679
1680	prepare_schedule (aTHX_ &ta);
1681	TRANSFER (ta, 1);
1682	}
1683
1684	static int	1698	static int
1685	api_cede (void)	1699	api_cede_notself (pTHX)
1686	{	1700	{
1687	dTHX;	1701	if (coro_nready)
		1702	{
1688	struct transfer_args ta;	1703	struct coro_transfer_args ta;
1689		1704
1690	prepare_cede (aTHX_ &ta);	1705	prepare_cede_notself (aTHX_ &ta);
1691
1692	if (expect_true (ta.prev != ta.next))
1693	{
1694	TRANSFER (ta, 1);	1706	TRANSFER (ta, 1);
1695	return 1;	1707	return 1;
1696	}	1708	}
1697	else	1709	else
1698	return 0;	1710	return 0;
1699	}	1711	}
1700		1712
1701	static int
1702	api_cede_notself (void)
1703	{
1704	dTHX;
1705	struct transfer_args ta;
1706
1707	if (prepare_cede_notself (aTHX_ &ta))
1708	{
1709	TRANSFER (ta, 1);
1710	return 1;
1711	}
1712	else
1713	return 0;
1714	}
1715
1716	static void	1713	static void
1717	api_trace (SV *coro_sv, int flags)	1714	api_trace (pTHX_ SV *coro_sv, int flags)
1718	{	1715	{
1719	dTHX;
1720	struct coro *coro = SvSTATE (coro_sv);	1716	struct coro *coro = SvSTATE (coro_sv);
1721		1717
1722	if (flags & CC_TRACE)	1718	if (flags & CC_TRACE)
1723	{	1719	{
1724	if (!coro->cctx)	1720	if (!coro->cctx)
…		…
1791	PerlIOCede *self = PerlIOSelf (f, PerlIOCede);	1787	PerlIOCede *self = PerlIOSelf (f, PerlIOCede);
1792	double now = nvtime ();	1788	double now = nvtime ();
1793		1789
1794	if (now >= self->next)	1790	if (now >= self->next)
1795	{	1791	{
1796	api_cede ();	1792	api_cede (aTHX);
1797	self->next = now + self->every;	1793	self->next = now + self->every;
1798	}	1794	}
1799		1795
1800	return PerlIOBuf_flush (aTHX_ f);	1796	return PerlIOBuf_flush (aTHX_ f);
1801	}	1797	}
…		…
1832	PerlIOBuf_set_ptrcnt,	1828	PerlIOBuf_set_ptrcnt,
1833	};	1829	};
1834		1830
1835	/*****************************************************************************/	1831	/*****************************************************************************/
1836		1832
1837	static const CV ssl_cv; / for quick consistency check */	1833	static const CV slf_cv; / for quick consistency check */
1838		1834
1839	static UNOP ssl_restore; /* restore stack as entersub did, for first-re-run */	1835	static UNOP slf_restore; /* restore stack as entersub did, for first-re-run */
1840	static SV *ssl_arg0;	1836	static SV *slf_arg0;
1841	static SV *ssl_arg1;	1837	static SV *slf_arg1;
1842		1838
1843	/* this restores the stack in the case we patched the entersub, to */	1839	/* this restores the stack in the case we patched the entersub, to */
1844	/* recreate the stack frame as perl will on following calls */	1840	/* recreate the stack frame as perl will on following calls */
1845	/* since entersub cleared the stack */	1841	/* since entersub cleared the stack */
1846	static OP *	1842	static OP *
…		…
1849	dSP;	1845	dSP;
1850		1846
1851	PUSHMARK (SP);	1847	PUSHMARK (SP);
1852		1848
1853	EXTEND (SP, 3);	1849	EXTEND (SP, 3);
1854	if (ssl_arg0) PUSHs (sv_2mortal (ssl_arg0)), ssl_arg0 = 0;	1850	if (slf_arg0) PUSHs (sv_2mortal (slf_arg0));
1855	if (ssl_arg1) PUSHs (sv_2mortal (ssl_arg1)), ssl_arg1 = 0;	1851	if (slf_arg1) PUSHs (sv_2mortal (slf_arg1));
1856	PUSHs ((SV *)CvGV (ssl_cv));	1852	PUSHs ((SV *)CvGV (slf_cv));
1857		1853
1858	RETURNOP (ssl_restore.op_first);	1854	RETURNOP (slf_restore.op_first);
1859	}	1855	}
1860		1856
1861	/* declare prototype */	1857	static void
1862	XS(XS_Coro__State__set_stacklevel);	1858	slf_init_set_stacklevel (pTHX_ SV **arg, int items)
		1859	{
		1860	assert (("FATAL: set_stacklevel needs the coro cctx as sole argument", items == 1));
		1861	CORO_SLF_DATA = (void *)SvIV (arg [0]);
		1862	}
1863		1863
1864	#define OPpENTERSUB_SSL 15	1864	static void
		1865	slf_prepare_set_stacklevel (pTHX_ struct coro_transfer_args *ta)
		1866	{
		1867	prepare_set_stacklevel (ta, (struct coro_cctx *)CORO_SLF_DATA);
		1868	}
1865		1869
		1870	static void
		1871	slf_init_transfer (pTHX_ SV **arg, int items)
		1872	{
		1873	if (items != 2)
		1874	croak ("Coro::State::transfer (prev, next) expects two arguments, not %d.", items);
		1875
		1876	CORO_SLF_DATA = (void )arg; / let's hope it will stay valid */
		1877	}
		1878
		1879	static void
		1880	slf_prepare_transfer (pTHX_ struct coro_transfer_args *ta)
		1881	{
		1882	SV arg = (SV )CORO_SLF_DATA;
		1883
		1884	prepare_transfer (ta, arg [0], arg [1]);
		1885	}
		1886
		1887	static void
		1888	slf_init_nop (pTHX_ SV **arg, int items)
		1889	{
		1890	}
		1891
		1892	/* slf_prepare_schedule == prepare_schedule */
		1893	/* slf_prepare_cede == prepare_cede */
		1894	/* slf_prepare_notself == prepare_notself */
		1895
		1896	/* we hijack an hopefully unused CV flag for our purposes */
		1897	#define CVf_SLF 0x4000
		1898
		1899	/*
		1900	* these not obviously related functions are all rolled into one
		1901	* function to increase chances that they all will call transfer with the same
		1902	* stack offset
		1903	* SLF stands for "schedule-like-function".
		1904	*/
1866	static OP *	1905	static OP *
1867	pp_set_stacklevel (pTHX)	1906	pp_slf (pTHX)
1868	{	1907	{
		1908	I32 checkmark; /* mark SP to see how many elements check has pushed */
		1909
		1910	if (expect_true (!slf_frame.prepare))
		1911	{
		1912	/* first iteration */
1869	dSP;	1913	dSP;
1870	struct transfer_args ta;
1871	SV **arg = PL_stack_base + TOPMARK + 1;	1914	SV **arg = PL_stack_base + TOPMARK + 1;
1872	int items = SP - arg; /* args without function object */	1915	int items = SP - arg; /* args without function object */
		1916	SV gv = sp;
		1917	struct CoroSLF *slf;
1873		1918
1874	/* do a quick consistency check on the "function" object, and if it isn't */	1919	/* do a quick consistency check on the "function" object, and if it isn't */
1875	/* for us, divert to the real entersub */	1920	/* for us, divert to the real entersub */
1876	if (SvTYPE (sp) != SVt_PVGV \|\| CvXSUB (GvCV (sp)) != XS_Coro__State__set_stacklevel)	1921	if (SvTYPE (gv) != SVt_PVGV \|\| !(CvFLAGS (GvCV (gv)) & CVf_SLF))
1877	return PL_ppaddr[OP_ENTERSUB](aTHX);	1922	return PL_ppaddr[OP_ENTERSUB](aTHX);
1878		1923
1879	/* pop args */	1924	/* pop args */
1880	SP = PL_stack_base + POPMARK;	1925	SP = PL_stack_base + POPMARK;
1881		1926
1882	if (!(PL_op->op_flags & OPf_STACKED))	1927	if (!(PL_op->op_flags & OPf_STACKED))
1883	{	1928	{
1884	/* ampersand-form of call, use @_ instead of stack */	1929	/* ampersand-form of call, use @_ instead of stack */
1885	AV *av = GvAV (PL_defgv);	1930	AV *av = GvAV (PL_defgv);
1886	arg = AvARRAY (av);	1931	arg = AvARRAY (av);
1887	items = AvFILLp (av) + 1;	1932	items = AvFILLp (av) + 1;
		1933	}
		1934
		1935	PUTBACK;
		1936
		1937	slf = (struct CoroSLF *)CvXSUBANY (GvCV (gv)).any_ptr;
		1938	slf_frame.prepare = slf->prepare;
		1939	slf_frame.check = slf->check;
		1940	slf->init (aTHX_ arg, items);
		1941	}
		1942
		1943	/* now interpret the slf_frame */
		1944	/* we use a callback system not to make the code needlessly */
		1945	/* complicated, but so we can run multiple perl coros from one cctx */
		1946
		1947	do
		1948	{
		1949	struct coro_transfer_args ta;
		1950
		1951	slf_frame.prepare (aTHX_ &ta);
		1952	TRANSFER (ta, 0);
		1953
		1954	checkmark = PL_stack_sp - PL_stack_base;
		1955	}
		1956	while (slf_frame.check (aTHX));
		1957
		1958	{
		1959	dSP;
		1960	SV **bot = PL_stack_base + checkmark;
		1961	int gimme = GIMME_V;
		1962
		1963	slf_frame.prepare = 0; /* signal pp_slf that we need a new frame */
		1964
		1965	/* make sure we put something on the stack in scalar context */
		1966	if (gimme == G_SCALAR)
		1967	{
		1968	if (sp == bot)
		1969	XPUSHs (&PL_sv_undef);
		1970
		1971	SP = bot + 1;
1888	}	1972	}
1889		1973
1890	PUTBACK;	1974	PUTBACK;
1891	switch (PL_op->op_private & OPpENTERSUB_SSL)	1975	}
1892	{
1893	case 0:
1894	prepare_set_stacklevel (&ta, (struct coro_cctx *)SvIV (arg [0]));
1895	break;
1896		1976
1897	case 1:	1977	return NORMAL;
		1978	}
		1979
		1980	static void
		1981	api_execute_slf (pTHX_ CV cv, const struct CoroSLF slf, SV **arg, int items)
		1982	{
		1983	assert (("FATAL: SLF call recursion in Coro module (please report)", PL_op->op_ppaddr != pp_slf));
		1984	assert (("FATAL: SLF call with illegal CV value", !CvANON (cv)));
		1985
1898	if (items != 2)	1986	if (items > 2)
1899	croak ("Coro::State::transfer (prev, next) expects two arguments, not %d.", items);	1987	croak ("Coro only supports a max of two arguments to SLF functions.");
1900		1988
1901	prepare_transfer (aTHX_ &ta, arg [0], arg [1]);	1989	CvFLAGS (cv) \|= CVf_SLF;
1902	break;	1990	CvXSUBANY (cv).any_ptr = (void *)slf;
		1991	slf_cv = cv;
1903		1992
1904	case 2:	1993	/* we patch the op, and then re-run the whole call */
1905	prepare_schedule (aTHX_ &ta);	1994	/* we have to put the same argument on the stack for this to work */
1906	break;	1995	/* and this will be done by pp_restore */
		1996	slf_restore.op_next = (OP *)&slf_restore;
		1997	slf_restore.op_type = OP_NULL;
		1998	slf_restore.op_ppaddr = pp_restore;
		1999	slf_restore.op_first = PL_op;
1907		2000
1908	case 3:	2001	slf_arg0 = items > 0 ? SvREFCNT_inc (arg [0]) : 0;
1909	prepare_cede (aTHX_ &ta);	2002	slf_arg1 = items > 1 ? SvREFCNT_inc (arg [1]) : 0;
1910	break;
1911		2003
1912	case 4:	2004	PL_op->op_ppaddr = pp_slf;
1913	if (!prepare_cede_notself (aTHX_ &ta))
1914	goto skip;
1915		2005
1916	break;	2006	PL_op = (OP *)&slf_restore;
1917	}
1918
1919	TRANSFER (ta, 0);
1920	SPAGAIN;
1921
1922	skip:
1923	PUTBACK;
1924	SSL_TAIL;
1925	SPAGAIN;
1926	RETURN;
1927	}	2007	}
1928		2008
1929	MODULE = Coro::State PACKAGE = Coro::State PREFIX = api_	2009	MODULE = Coro::State PACKAGE = Coro::State PREFIX = api_
1930		2010
1931	PROTOTYPES: DISABLE	2011	PROTOTYPES: DISABLE
1932
1933	# these not obviously related functions are all rolled into the same xs
1934	# function to increase chances that they all will call transfer with the same
1935	# stack offset
1936	void
1937	_set_stacklevel (...)
1938	ALIAS:
1939	Coro::State::transfer = 1
1940	Coro::schedule = 2
1941	Coro::cede = 3
1942	Coro::cede_notself = 4
1943	CODE:
1944	{
1945	assert (("FATAL: ssl call recursion in Coro module (please report)", PL_op->op_ppaddr != pp_set_stacklevel));
1946
1947	assert (("FATAL: ssl call with illegal CV value", CvGV (cv)));
1948	ssl_cv = cv;
1949
1950	/* we patch the op, and then re-run the whole call */
1951	/* we have to put some dummy argument on the stack for this to work */
1952	ssl_restore.op_next = (OP *)&ssl_restore;
1953	ssl_restore.op_type = OP_NULL;
1954	ssl_restore.op_ppaddr = pp_restore;
1955	ssl_restore.op_first = PL_op;
1956
1957	ssl_arg0 = items > 0 ? SvREFCNT_inc (ST (0)) : 0;
1958	ssl_arg1 = items > 1 ? SvREFCNT_inc (ST (1)) : 0;
1959
1960	PL_op->op_ppaddr = pp_set_stacklevel;
1961	PL_op->op_private = PL_op->op_private & ~OPpENTERSUB_SSL \| ix; /* we potentially share our private flags with entersub */
1962
1963	PL_op = (OP *)&ssl_restore;
1964	}
1965		2012
1966	BOOT:	2013	BOOT:
1967	{	2014	{
1968	#ifdef USE_ITHREADS	2015	#ifdef USE_ITHREADS
1969	MUTEX_INIT (&coro_lock);	2016	MUTEX_INIT (&coro_lock);
…		…
1995	main_top_env = PL_top_env;	2042	main_top_env = PL_top_env;
1996		2043
1997	while (main_top_env->je_prev)	2044	while (main_top_env->je_prev)
1998	main_top_env = main_top_env->je_prev;	2045	main_top_env = main_top_env->je_prev;
1999		2046
2000	coroapi.ver = CORO_API_VERSION;	2047	coroapi.ver = CORO_API_VERSION;
2001	coroapi.rev = CORO_API_REVISION;	2048	coroapi.rev = CORO_API_REVISION;
2002	coroapi.transfer = api_transfer;	2049	coroapi.transfer = api_transfer;
		2050	coroapi.execute_slf = api_execute_slf;
		2051	coroapi.sv_state = SvSTATE_;
2003		2052
2004	{	2053	{
2005	SV **svp = hv_fetch (PL_modglobal, "Time::NVtime", 12, 0);	2054	SV **svp = hv_fetch (PL_modglobal, "Time::NVtime", 12, 0);
2006		2055
2007	if (!svp) croak ("Time::HiRes is required");	2056	if (!svp) croak ("Time::HiRes is required");
…		…
2039	for (i = 1; i < items; i++)	2088	for (i = 1; i < items; i++)
2040	av_push (coro->args, newSVsv (ST (i)));	2089	av_push (coro->args, newSVsv (ST (i)));
2041	}	2090	}
2042	OUTPUT:	2091	OUTPUT:
2043	RETVAL	2092	RETVAL
		2093
		2094	void
		2095	_set_stacklevel (...)
		2096	CODE:
		2097	{
		2098	static struct CoroSLF slf = { slf_init_set_stacklevel, slf_prepare_set_stacklevel, slf_check_nop };
		2099	api_execute_slf (aTHX_ cv, &slf, &ST (0), items);
		2100	}
		2101
		2102	void
		2103	transfer (...)
		2104	CODE:
		2105	{
		2106	static struct CoroSLF slf = { slf_init_transfer, slf_prepare_transfer, slf_check_nop };
		2107	api_execute_slf (aTHX_ cv, &slf, &ST (0), items);
		2108	}
2044		2109
2045	bool	2110	bool
2046	_destroy (SV *coro_sv)	2111	_destroy (SV *coro_sv)
2047	CODE:	2112	CODE:
2048	RETVAL = coro_state_destroy (aTHX_ SvSTATE (coro_sv));	2113	RETVAL = coro_state_destroy (aTHX_ SvSTATE (coro_sv));
…		…
2166	SvREFCNT_dec (self->throw);	2231	SvREFCNT_dec (self->throw);
2167	self->throw = SvOK (throw) ? newSVsv (throw) : 0;	2232	self->throw = SvOK (throw) ? newSVsv (throw) : 0;
2168		2233
2169	void	2234	void
2170	api_trace (SV *coro, int flags = CC_TRACE \| CC_TRACE_SUB)	2235	api_trace (SV *coro, int flags = CC_TRACE \| CC_TRACE_SUB)
		2236	C_ARGS: aTHX_ coro, flags
2171		2237
2172	SV *	2238	SV *
2173	has_cctx (Coro::State coro)	2239	has_cctx (Coro::State coro)
2174	PROTOTYPE: $	2240	PROTOTYPE: $
2175	CODE:	2241	CODE:
…		…
2252	coroapi.schedule = api_schedule;	2318	coroapi.schedule = api_schedule;
2253	coroapi.cede = api_cede;	2319	coroapi.cede = api_cede;
2254	coroapi.cede_notself = api_cede_notself;	2320	coroapi.cede_notself = api_cede_notself;
2255	coroapi.ready = api_ready;	2321	coroapi.ready = api_ready;
2256	coroapi.is_ready = api_is_ready;	2322	coroapi.is_ready = api_is_ready;
2257	coroapi.nready = &coro_nready;	2323	coroapi.nready = coro_nready;
2258	coroapi.current = coro_current;	2324	coroapi.current = coro_current;
2259		2325
2260	GCoroAPI = &coroapi;	2326	GCoroAPI = &coroapi;
2261	sv_setiv (sv, (IV)&coroapi);	2327	sv_setiv (sv, (IV)&coroapi);
2262	SvREADONLY_on (sv);	2328	SvREADONLY_on (sv);
2263	}	2329	}
		2330	}
		2331
		2332	void
		2333	schedule (...)
		2334	CODE:
		2335	{
		2336	static struct CoroSLF slf = { slf_init_nop, prepare_schedule, slf_check_nop };
		2337	api_execute_slf (aTHX_ cv, &slf, &ST (0), items);
		2338	}
		2339
		2340	void
		2341	cede (...)
		2342	CODE:
		2343	{
		2344	static struct CoroSLF slf = { slf_init_nop, prepare_cede, slf_check_nop };
		2345	api_execute_slf (aTHX_ cv, &slf, &ST (0), items);
		2346	}
		2347
		2348	void
		2349	cede_notself (...)
		2350	CODE:
		2351	{
		2352	static struct CoroSLF slf = { slf_init_nop, prepare_cede_notself, slf_check_nop };
		2353	api_execute_slf (aTHX_ cv, &slf, &ST (0), items);
2264	}	2354	}
2265		2355
2266	void	2356	void
2267	_set_current (SV *current)	2357	_set_current (SV *current)
2268	PROTOTYPE: $	2358	PROTOTYPE: $
…		…
2303		2393
2304	SV *	2394	SV *
2305	ready (SV *self)	2395	ready (SV *self)
2306	PROTOTYPE: $	2396	PROTOTYPE: $
2307	CODE:	2397	CODE:
2308	RETVAL = boolSV (api_ready (self));	2398	RETVAL = boolSV (api_ready (aTHX_ self));
2309	OUTPUT:	2399	OUTPUT:
2310	RETVAL	2400	RETVAL
2311		2401
2312	int	2402	int
2313	nready (...)	2403	nready (...)
…		…
2383	newSVpvn ("[async_pool idle]", sizeof ("[async_pool idle]") - 1), 0);	2473	newSVpvn ("[async_pool idle]", sizeof ("[async_pool idle]") - 1), 0);
2384		2474
2385	coro->prio = 0;	2475	coro->prio = 0;
2386		2476
2387	if (coro->cctx && (coro->cctx->flags & CC_TRACE))	2477	if (coro->cctx && (coro->cctx->flags & CC_TRACE))
2388	api_trace (coro_current, 0);	2478	api_trace (aTHX_ coro_current, 0);
2389		2479
2390	av_push (av_async_pool, newSVsv (coro_current));	2480	av_push (av_async_pool, newSVsv (coro_current));
2391	}	2481	}
2392		2482
2393	#if 0	2483	#if 0
…		…
2465		2555
2466	av_push (av, data_sv);	2556	av_push (av, data_sv);
2467		2557
2468	XPUSHs (sv_2mortal (newRV_noinc ((SV *)av)));	2558	XPUSHs (sv_2mortal (newRV_noinc ((SV *)av)));
2469		2559
2470	api_ready (self);	2560	api_ready (aTHX_ self);
2471	}	2561	}
2472		2562
2473	void	2563	void
2474	_set_state (SV *state)	2564	_set_state (SV *state)
2475	PROTOTYPE: $	2565	PROTOTYPE: $
…		…
2500	PROTOTYPE: @	2590	PROTOTYPE: @
2501	CODE:	2591	CODE:
2502	{	2592	{
2503	static int incede;	2593	static int incede;
2504		2594
2505	api_cede_notself ();	2595	api_cede_notself (aTHX);
2506		2596
2507	++incede;	2597	++incede;
2508	while (coro_nready >= incede && api_cede ())	2598	while (coro_nready >= incede && api_cede (aTHX))
2509	;	2599	;
2510		2600
2511	sv_setsv (sv_activity, &PL_sv_undef);	2601	sv_setsv (sv_activity, &PL_sv_undef);
2512	if (coro_nready >= incede)	2602	if (coro_nready >= incede)
2513	{	2603	{

Diff Legend

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

Comparing Coro/Coro/State.xs (file contents): Revision 1.266 by root, Fri Nov 14 03:26:22 2008 UTC vs. Revision 1.272 by root, Fri Nov 14 20:35:49 2008 UTC

Diff Legend

Comparing Coro/Coro/State.xs (file contents):
Revision 1.266 by root, Fri Nov 14 03:26:22 2008 UTC vs.
Revision 1.272 by root, Fri Nov 14 20:35:49 2008 UTC