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

Comparing Coro/Coro/State.xs (file contents):
Revision 1.264 by root, Fri Nov 14 02:29:09 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
…		…
723	#ifndef MgPV_nolen_const	742	#ifndef MgPV_nolen_const
724	#define MgPV_nolen_const(mg) (((((int)(mg)->mg_len)) == HEf_SVKEY) ? \	743	#define MgPV_nolen_const(mg) (((((int)(mg)->mg_len)) == HEf_SVKEY) ? \
725	SvPV_nolen((SV*)((mg)->mg_ptr)) : \	744	SvPV_nolen((SV*)((mg)->mg_ptr)) : \
726	(const char*)(mg)->mg_ptr)	745	(const char*)(mg)->mg_ptr)
727	#endif	746	#endif
728
729	/* we sometimes need to create the effect of entersub calling us */
730	#define SSL_HEAD (void)0
731	/* we somtimes need to create the effect of leaving via entersub */
732	#define SSL_TAIL (void)0
733		747
734	/*	748	/*
735	* This overrides the default magic get method of %SIG elements.	749	* This overrides the default magic get method of %SIG elements.
736	* 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
737	* 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
…		…
809		823
810	return orig_sigelem_set ? orig_sigelem_set (aTHX_ sv, mg) : 0;	824	return orig_sigelem_set ? orig_sigelem_set (aTHX_ sv, mg) : 0;
811	}	825	}
812		826
813	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
814	coro_setup (pTHX_ struct coro *coro)	841	coro_setup (pTHX_ struct coro *coro)
815	{	842	{
816	/*	843	/*
817	* emulate part of the perl startup here.	844	* emulate part of the perl startup here.
818	*/	845	*/
…		…
857	PL_op = PL_ppaddr[OP_ENTERSUB](aTHX);	884	PL_op = PL_ppaddr[OP_ENTERSUB](aTHX);
858	SPAGAIN;	885	SPAGAIN;
859	}	886	}
860		887
861	/* 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
862	* likely was suspended in set_stacklevel, called from entersub.	889	* likely was suspended in pp_slf, so we have to emulate entering pp_slf here.
863	* set_stacklevel doesn't do anything on return, but entersub does LEAVE,
864	* so we ENTER here for symmetry.
865	*/	890	*/
866	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 */
867	}	893	}
868		894
869	static void	895	static void
870	coro_destruct (pTHX_ struct coro *coro)	896	coro_destruct (pTHX_ struct coro *coro)
871	{	897	{
…		…
1035	TAINT_NOT;	1061	TAINT_NOT;
1036	return 0;	1062	return 0;
1037	}	1063	}
1038		1064
1039	static void	1065	static void
1040	prepare_set_stacklevel (struct transfer_args ta, struct coro_cctx cctx)	1066	prepare_set_stacklevel (struct coro_transfer_args ta, struct coro_cctx cctx)
1041	{	1067	{
1042	ta->prev = (struct coro *)cctx;	1068	ta->prev = (struct coro *)cctx;
1043	ta->next = 0;	1069	ta->next = 0;
1044	}	1070	}
1045		1071
…		…
1105	# endif	1131	# endif
1106	#endif	1132	#endif
1107	{	1133	{
1108	dTHX;	1134	dTHX;
1109		1135
1110	/* entersub called ENTER, but we never 'returned', undo that here */	1136	/* normally we would need to skip the entersub here */
1111	SSL_TAIL;	1137	/* not doing so will re-execute it, which is exactly what we want */
1112
1113	/* we now skip the op that did lead to transfer() */
1114	PL_op = PL_op->op_next;	1138	/* PL_nop = PL_nop->op_next */
1115		1139
1116	/* inject a fake subroutine call to cctx_init */	1140	/* inject a fake subroutine call to cctx_init */
1117	cctx_prepare (aTHX_ (coro_cctx *)arg);	1141	cctx_prepare (aTHX_ (coro_cctx *)arg);
1118		1142
1119	/* 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 */
1120	transfer_tail (aTHX);	1145	transfer_tail (aTHX);
1121		1146
1122	/* 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 */
1123	PL_restartop = PL_op;	1148	PL_restartop = PL_op;
1124	perl_run (PL_curinterp);	1149	perl_run (PL_curinterp);
…		…
1307	dSTACKLEVEL;	1332	dSTACKLEVEL;
1308		1333
1309	/* sometimes transfer is only called to set idle_sp */	1334	/* sometimes transfer is only called to set idle_sp */
1310	if (expect_false (!next))	1335	if (expect_false (!next))
1311	{	1336	{
1312	((coro_cctx *)prev)->idle_sp = STACKLEVEL;	1337	((coro_cctx *)prev)->idle_sp = stacklevel;
1313	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 */
1314	}	1339	}
1315	else if (expect_true (prev != next))	1340	else if (expect_true (prev != next))
1316	{	1341	{
1317	coro_cctx *prev__cctx;	1342	coro_cctx *prev__cctx;
…		…
1344		1369
1345	prev__cctx = prev->cctx;	1370	prev__cctx = prev->cctx;
1346		1371
1347	/* possibly untie and reuse the cctx */	1372	/* possibly untie and reuse the cctx */
1348	if (expect_true (	1373	if (expect_true (
1349	prev__cctx->idle_sp == STACKLEVEL	1374	prev__cctx->idle_sp == stacklevel
1350	&& !(prev__cctx->flags & CC_TRACE)	1375	&& !(prev__cctx->flags & CC_TRACE)
1351	&& !force_cctx	1376	&& !force_cctx
1352	))	1377	))
1353	{	1378	{
1354	/* 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 */
1355	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));
1356		1381
1357	prev->cctx = 0;	1382	prev->cctx = 0;
1358		1383
1359	/* 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 */
…		…
1472	# define MGf_DUP 0	1497	# define MGf_DUP 0
1473	#endif	1498	#endif
1474	};	1499	};
1475		1500
1476	static void	1501	static void
1477	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)
1478	{	1503	{
1479	ta->prev = SvSTATE (prev_sv);	1504	ta->prev = SvSTATE (prev_sv);
1480	ta->next = SvSTATE (next_sv);	1505	ta->next = SvSTATE (next_sv);
1481	TRANSFER_CHECK (*ta);	1506	TRANSFER_CHECK (*ta);
1482	}	1507	}
1483		1508
1484	static void	1509	static void
1485	api_transfer (SV prev_sv, SV next_sv)	1510	api_transfer (pTHX_ SV prev_sv, SV next_sv)
1486	{	1511	{
1487	dTHX;
1488	struct transfer_args ta;	1512	struct coro_transfer_args ta;
1489		1513
1490	prepare_transfer (aTHX_ &ta, prev_sv, next_sv);	1514	prepare_transfer (aTHX_ &ta, prev_sv, next_sv);
1491	TRANSFER (ta, 1);	1515	TRANSFER (ta, 1);
1492	}	1516	}
1493		1517
…		…
1510		1534
1511	return 0;	1535	return 0;
1512	}	1536	}
1513		1537
1514	static int	1538	static int
1515	api_ready (SV *coro_sv)	1539	api_ready (pTHX_ SV *coro_sv)
1516	{	1540	{
1517	dTHX;
1518	struct coro *coro;	1541	struct coro *coro;
1519	SV *sv_hook;	1542	SV *sv_hook;
1520	void (*xs_hook)(void);	1543	void (*xs_hook)(void);
1521		1544
1522	if (SvROK (coro_sv))	1545	if (SvROK (coro_sv))
…		…
1560		1583
1561	return 1;	1584	return 1;
1562	}	1585	}
1563		1586
1564	static int	1587	static int
1565	api_is_ready (SV *coro_sv)	1588	api_is_ready (pTHX_ SV *coro_sv)
1566	{	1589	{
1567	dTHX;
1568
1569	return !!(SvSTATE (coro_sv)->flags & CF_READY);	1590	return !!(SvSTATE (coro_sv)->flags & CF_READY);
1570	}	1591	}
1571		1592
1572	INLINE void	1593	INLINE void
1573	prepare_schedule (pTHX_ struct transfer_args *ta)	1594	prepare_schedule (pTHX_ struct coro_transfer_args *ta)
1574	{	1595	{
1575	SV prev_sv, next_sv;	1596	SV prev_sv, next_sv;
1576		1597
1577	for (;;)	1598	for (;;)
1578	{	1599	{
…		…
1627	coro_mortal = prev_sv;	1648	coro_mortal = prev_sv;
1628	UNLOCK;	1649	UNLOCK;
1629	}	1650	}
1630		1651
1631	INLINE void	1652	INLINE void
1632	prepare_cede (pTHX_ struct transfer_args *ta)	1653	prepare_cede (pTHX_ struct coro_transfer_args *ta)
1633	{	1654	{
1634	api_ready (coro_current);	1655	api_ready (aTHX_ coro_current);
1635	prepare_schedule (aTHX_ ta);	1656	prepare_schedule (aTHX_ ta);
1636	}	1657	}
1637		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
1638	static int	1682	static int
1639	prepare_cede_notself (pTHX_ struct transfer_args *ta)	1683	api_cede (pTHX)
1640	{	1684	{
1641	if (coro_nready)	1685	struct coro_transfer_args ta;
1642	{	1686
1643	SV *prev = SvRV (coro_current);
1644	prepare_schedule (aTHX_ ta);	1687	prepare_cede (aTHX_ &ta);
1645	api_ready (prev);	1688
		1689	if (expect_true (ta.prev != ta.next))
		1690	{
		1691	TRANSFER (ta, 1);
1646	return 1;	1692	return 1;
1647	}	1693	}
1648	else	1694	else
1649	return 0;	1695	return 0;
1650	}	1696	}
1651		1697
1652	static void
1653	api_schedule (void)
1654	{
1655	dTHX;
1656	struct transfer_args ta;
1657
1658	prepare_schedule (aTHX_ &ta);
1659	TRANSFER (ta, 1);
1660	}
1661
1662	static int	1698	static int
1663	api_cede (void)	1699	api_cede_notself (pTHX)
1664	{	1700	{
1665	dTHX;	1701	if (coro_nready)
		1702	{
1666	struct transfer_args ta;	1703	struct coro_transfer_args ta;
1667		1704
1668	prepare_cede (aTHX_ &ta);	1705	prepare_cede_notself (aTHX_ &ta);
1669
1670	if (expect_true (ta.prev != ta.next))
1671	{
1672	TRANSFER (ta, 1);	1706	TRANSFER (ta, 1);
1673	return 1;	1707	return 1;
1674	}	1708	}
1675	else	1709	else
1676	return 0;	1710	return 0;
1677	}	1711	}
1678		1712
1679	static int
1680	api_cede_notself (void)
1681	{
1682	dTHX;
1683	struct transfer_args ta;
1684
1685	if (prepare_cede_notself (aTHX_ &ta))
1686	{
1687	TRANSFER (ta, 1);
1688	return 1;
1689	}
1690	else
1691	return 0;
1692	}
1693
1694	static void	1713	static void
1695	api_trace (SV *coro_sv, int flags)	1714	api_trace (pTHX_ SV *coro_sv, int flags)
1696	{	1715	{
1697	dTHX;
1698	struct coro *coro = SvSTATE (coro_sv);	1716	struct coro *coro = SvSTATE (coro_sv);
1699		1717
1700	if (flags & CC_TRACE)	1718	if (flags & CC_TRACE)
1701	{	1719	{
1702	if (!coro->cctx)	1720	if (!coro->cctx)
…		…
1769	PerlIOCede *self = PerlIOSelf (f, PerlIOCede);	1787	PerlIOCede *self = PerlIOSelf (f, PerlIOCede);
1770	double now = nvtime ();	1788	double now = nvtime ();
1771		1789
1772	if (now >= self->next)	1790	if (now >= self->next)
1773	{	1791	{
1774	api_cede ();	1792	api_cede (aTHX);
1775	self->next = now + self->every;	1793	self->next = now + self->every;
1776	}	1794	}
1777		1795
1778	return PerlIOBuf_flush (aTHX_ f);	1796	return PerlIOBuf_flush (aTHX_ f);
1779	}	1797	}
…		…
1810	PerlIOBuf_set_ptrcnt,	1828	PerlIOBuf_set_ptrcnt,
1811	};	1829	};
1812		1830
1813	/*****************************************************************************/	1831	/*****************************************************************************/
1814		1832
1815	static const CV ssl_cv; / for quick consistency check */	1833	static const CV slf_cv; / for quick consistency check */
1816		1834
1817	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 */
1818	static SV *ssl_arg0;	1836	static SV *slf_arg0;
1819	static SV *ssl_arg1;	1837	static SV *slf_arg1;
1820		1838
1821	/* 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 */
1822	/* recreate the stack frame as perl will on following calls */	1840	/* recreate the stack frame as perl will on following calls */
1823	/* since entersub cleared the stack */	1841	/* since entersub cleared the stack */
1824	static OP *	1842	static OP *
…		…
1827	dSP;	1845	dSP;
1828		1846
1829	PUSHMARK (SP);	1847	PUSHMARK (SP);
1830		1848
1831	EXTEND (SP, 3);	1849	EXTEND (SP, 3);
1832	if (ssl_arg0) PUSHs (sv_2mortal (ssl_arg0)), ssl_arg0 = 0;	1850	if (slf_arg0) PUSHs (sv_2mortal (slf_arg0));
1833	if (ssl_arg1) PUSHs (sv_2mortal (ssl_arg1)), ssl_arg1 = 0;	1851	if (slf_arg1) PUSHs (sv_2mortal (slf_arg1));
1834	PUSHs ((SV *)CvGV (ssl_cv));	1852	PUSHs ((SV *)CvGV (slf_cv));
1835		1853
1836	RETURNOP (ssl_restore.op_first);	1854	RETURNOP (slf_restore.op_first);
1837	}	1855	}
1838		1856
1839	/* declare prototype */	1857	static void
1840	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	}
1841		1863
		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	}
		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	*/
1842	static OP *	1905	static OP *
1843	pp_set_stacklevel (pTHX)	1906	pp_slf (pTHX)
1844	{	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 */
1845	dSP;	1913	dSP;
1846	struct transfer_args ta;
1847	SV **arg = PL_stack_base + TOPMARK + 1;	1914	SV **arg = PL_stack_base + TOPMARK + 1;
1848	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;
1849		1918
1850	/* 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 */
1851	/* for us, divert to the real entersub */	1920	/* for us, divert to the real entersub */
1852	if (SvTYPE (sp) != SVt_PVGV \|\| CvXSUB (GvCV (sp)) != XS_Coro__State__set_stacklevel)	1921	if (SvTYPE (gv) != SVt_PVGV \|\| !(CvFLAGS (GvCV (gv)) & CVf_SLF))
1853	return PL_ppaddr[OP_ENTERSUB](aTHX);	1922	return PL_ppaddr[OP_ENTERSUB](aTHX);
1854		1923
1855	/* pop args */	1924	/* pop args */
1856	SP = PL_stack_base + POPMARK;	1925	SP = PL_stack_base + POPMARK;
1857		1926
1858	if (!(PL_op->op_flags & OPf_STACKED))	1927	if (!(PL_op->op_flags & OPf_STACKED))
1859	{	1928	{
1860	/* ampersand-form of call, use @_ instead of stack */	1929	/* ampersand-form of call, use @_ instead of stack */
1861	AV *av = GvAV (PL_defgv);	1930	AV *av = GvAV (PL_defgv);
1862	arg = AvARRAY (av);	1931	arg = AvARRAY (av);
1863	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;
1864	}	1972	}
1865		1973
1866	PUTBACK;	1974	PUTBACK;
1867	switch (PL_op->op_private & 7)	1975	}
1868	{
1869	case 0:
1870	prepare_set_stacklevel (&ta, (struct coro_cctx *)SvIV (arg [0]));
1871	break;
1872		1976
1873	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
1874	if (items != 2)	1986	if (items > 2)
1875	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.");
1876		1988
1877	prepare_transfer (aTHX_ &ta, arg [0], arg [1]);	1989	CvFLAGS (cv) \|= CVf_SLF;
1878	break;	1990	CvXSUBANY (cv).any_ptr = (void *)slf;
		1991	slf_cv = cv;
1879		1992
1880	case 2:	1993	/* we patch the op, and then re-run the whole call */
1881	prepare_schedule (aTHX_ &ta);	1994	/* we have to put the same argument on the stack for this to work */
1882	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;
1883		2000
1884	case 3:	2001	slf_arg0 = items > 0 ? SvREFCNT_inc (arg [0]) : 0;
1885	prepare_cede (aTHX_ &ta);	2002	slf_arg1 = items > 1 ? SvREFCNT_inc (arg [1]) : 0;
1886	break;
1887		2003
1888	case 4:	2004	PL_op->op_ppaddr = pp_slf;
1889	if (!prepare_cede_notself (aTHX_ &ta))
1890	RETURN;
1891		2005
1892	break;	2006	PL_op = (OP *)&slf_restore;
1893	}
1894
1895	TRANSFER (ta, 0);
1896	SPAGAIN;
1897
1898	skip:
1899
1900	RETURN;
1901	}	2007	}
1902		2008
1903	MODULE = Coro::State PACKAGE = Coro::State PREFIX = api_	2009	MODULE = Coro::State PACKAGE = Coro::State PREFIX = api_
1904		2010
1905	PROTOTYPES: DISABLE	2011	PROTOTYPES: DISABLE
1906
1907	# these not obviously related functions are all rolled into the same xs
1908	# function to increase chances that they all will call transfer with the same
1909	# stack offset
1910	void
1911	_set_stacklevel (...)
1912	ALIAS:
1913	Coro::State::transfer = 1
1914	Coro::schedule = 2
1915	Coro::cede = 3
1916	Coro::cede_notself = 4
1917	CODE:
1918	{
1919	assert (("FATAL: ssl call recursion in Coro module (please report)", PL_op->op_ppaddr != pp_set_stacklevel));
1920
1921	/* we patch the op, and then re-run the whole call */
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		2012
1938	BOOT:	2013	BOOT:
1939	{	2014	{
1940	#ifdef USE_ITHREADS	2015	#ifdef USE_ITHREADS
1941	MUTEX_INIT (&coro_lock);	2016	MUTEX_INIT (&coro_lock);
…		…
1943	coro_thx = PERL_GET_CONTEXT;	2018	coro_thx = PERL_GET_CONTEXT;
1944	# endif	2019	# endif
1945	#endif	2020	#endif
1946	BOOT_PAGESIZE;	2021	BOOT_PAGESIZE;
1947		2022
1948	ssl_cv = get_cv ("Coro::State::_set_stacklevel", 0);
1949
1950	irsgv = gv_fetchpv ("/" , GV_ADD\|GV_NOTQUAL, SVt_PV);	2023	irsgv = gv_fetchpv ("/" , GV_ADD\|GV_NOTQUAL, SVt_PV);
1951	stdoutgv = gv_fetchpv ("STDOUT", GV_ADD\|GV_NOTQUAL, SVt_PVIO);	2024	stdoutgv = gv_fetchpv ("STDOUT", GV_ADD\|GV_NOTQUAL, SVt_PVIO);
1952		2025
1953	orig_sigelem_get = PL_vtbl_sigelem.svt_get; PL_vtbl_sigelem.svt_get = coro_sigelem_get;	2026	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;	2027	orig_sigelem_set = PL_vtbl_sigelem.svt_set; PL_vtbl_sigelem.svt_set = coro_sigelem_set;
…		…
1969	main_top_env = PL_top_env;	2042	main_top_env = PL_top_env;
1970		2043
1971	while (main_top_env->je_prev)	2044	while (main_top_env->je_prev)
1972	main_top_env = main_top_env->je_prev;	2045	main_top_env = main_top_env->je_prev;
1973		2046
1974	coroapi.ver = CORO_API_VERSION;	2047	coroapi.ver = CORO_API_VERSION;
1975	coroapi.rev = CORO_API_REVISION;	2048	coroapi.rev = CORO_API_REVISION;
1976	coroapi.transfer = api_transfer;	2049	coroapi.transfer = api_transfer;
		2050	coroapi.execute_slf = api_execute_slf;
		2051	coroapi.sv_state = SvSTATE_;
1977		2052
1978	{	2053	{
1979	SV **svp = hv_fetch (PL_modglobal, "Time::NVtime", 12, 0);	2054	SV **svp = hv_fetch (PL_modglobal, "Time::NVtime", 12, 0);
1980		2055
1981	if (!svp) croak ("Time::HiRes is required");	2056	if (!svp) croak ("Time::HiRes is required");
…		…
2013	for (i = 1; i < items; i++)	2088	for (i = 1; i < items; i++)
2014	av_push (coro->args, newSVsv (ST (i)));	2089	av_push (coro->args, newSVsv (ST (i)));
2015	}	2090	}
2016	OUTPUT:	2091	OUTPUT:
2017	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	}
2018		2109
2019	bool	2110	bool
2020	_destroy (SV *coro_sv)	2111	_destroy (SV *coro_sv)
2021	CODE:	2112	CODE:
2022	RETVAL = coro_state_destroy (aTHX_ SvSTATE (coro_sv));	2113	RETVAL = coro_state_destroy (aTHX_ SvSTATE (coro_sv));
…		…
2140	SvREFCNT_dec (self->throw);	2231	SvREFCNT_dec (self->throw);
2141	self->throw = SvOK (throw) ? newSVsv (throw) : 0;	2232	self->throw = SvOK (throw) ? newSVsv (throw) : 0;
2142		2233
2143	void	2234	void
2144	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
2145		2237
2146	SV *	2238	SV *
2147	has_cctx (Coro::State coro)	2239	has_cctx (Coro::State coro)
2148	PROTOTYPE: $	2240	PROTOTYPE: $
2149	CODE:	2241	CODE:
…		…
2226	coroapi.schedule = api_schedule;	2318	coroapi.schedule = api_schedule;
2227	coroapi.cede = api_cede;	2319	coroapi.cede = api_cede;
2228	coroapi.cede_notself = api_cede_notself;	2320	coroapi.cede_notself = api_cede_notself;
2229	coroapi.ready = api_ready;	2321	coroapi.ready = api_ready;
2230	coroapi.is_ready = api_is_ready;	2322	coroapi.is_ready = api_is_ready;
2231	coroapi.nready = &coro_nready;	2323	coroapi.nready = coro_nready;
2232	coroapi.current = coro_current;	2324	coroapi.current = coro_current;
2233		2325
2234	GCoroAPI = &coroapi;	2326	GCoroAPI = &coroapi;
2235	sv_setiv (sv, (IV)&coroapi);	2327	sv_setiv (sv, (IV)&coroapi);
2236	SvREADONLY_on (sv);	2328	SvREADONLY_on (sv);
2237	}	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);
2238	}	2354	}
2239		2355
2240	void	2356	void
2241	_set_current (SV *current)	2357	_set_current (SV *current)
2242	PROTOTYPE: $	2358	PROTOTYPE: $
…		…
2277		2393
2278	SV *	2394	SV *
2279	ready (SV *self)	2395	ready (SV *self)
2280	PROTOTYPE: $	2396	PROTOTYPE: $
2281	CODE:	2397	CODE:
2282	RETVAL = boolSV (api_ready (self));	2398	RETVAL = boolSV (api_ready (aTHX_ self));
2283	OUTPUT:	2399	OUTPUT:
2284	RETVAL	2400	RETVAL
2285		2401
2286	int	2402	int
2287	nready (...)	2403	nready (...)
…		…
2357	newSVpvn ("[async_pool idle]", sizeof ("[async_pool idle]") - 1), 0);	2473	newSVpvn ("[async_pool idle]", sizeof ("[async_pool idle]") - 1), 0);
2358		2474
2359	coro->prio = 0;	2475	coro->prio = 0;
2360		2476
2361	if (coro->cctx && (coro->cctx->flags & CC_TRACE))	2477	if (coro->cctx && (coro->cctx->flags & CC_TRACE))
2362	api_trace (coro_current, 0);	2478	api_trace (aTHX_ coro_current, 0);
2363		2479
2364	av_push (av_async_pool, newSVsv (coro_current));	2480	av_push (av_async_pool, newSVsv (coro_current));
2365	}	2481	}
2366		2482
2367	#if 0	2483	#if 0
…		…
2439		2555
2440	av_push (av, data_sv);	2556	av_push (av, data_sv);
2441		2557
2442	XPUSHs (sv_2mortal (newRV_noinc ((SV *)av)));	2558	XPUSHs (sv_2mortal (newRV_noinc ((SV *)av)));
2443		2559
2444	api_ready (self);	2560	api_ready (aTHX_ self);
2445	}	2561	}
2446		2562
2447	void	2563	void
2448	_set_state (SV *state)	2564	_set_state (SV *state)
2449	PROTOTYPE: $	2565	PROTOTYPE: $
…		…
2474	PROTOTYPE: @	2590	PROTOTYPE: @
2475	CODE:	2591	CODE:
2476	{	2592	{
2477	static int incede;	2593	static int incede;
2478		2594
2479	api_cede_notself ();	2595	api_cede_notself (aTHX);
2480		2596
2481	++incede;	2597	++incede;
2482	while (coro_nready >= incede && api_cede ())	2598	while (coro_nready >= incede && api_cede (aTHX))
2483	;	2599	;
2484		2600
2485	sv_setsv (sv_activity, &PL_sv_undef);	2601	sv_setsv (sv_activity, &PL_sv_undef);
2486	if (coro_nready >= incede)	2602	if (coro_nready >= incede)
2487	{	2603	{

Diff Legend

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

Comparing Coro/Coro/State.xs (file contents): Revision 1.264 by root, Fri Nov 14 02:29:09 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.264 by root, Fri Nov 14 02:29:09 2008 UTC vs.
Revision 1.272 by root, Fri Nov 14 20:35:49 2008 UTC