[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.273 by root, Fri Nov 14 23:48:10 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;
…		…
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 a structure representing a perl-level coroutine */	257	/* this is a structure representing a perl-level coroutine */
258	struct coro {	258	struct coro {
259	/* the c coroutine allocated to this perl coroutine, if any */	259	/* the C coroutine allocated to this perl coroutine, if any */
260	coro_cctx *cctx;	260	coro_cctx *cctx;
261		261
262	/* process data */	262	/* process data */
		263	struct CoroSLF slf_frame; /* saved slf frame */
263	AV *mainstack;	264	AV *mainstack;
264	perl_slots slot; / basically the saved sp */	265	perl_slots slot; / basically the saved sp */
265		266
266	AV args; / data associated with this coroutine (initial args) */	267	AV args; / data associated with this coroutine (initial args) */
267	int refcnt; /* coroutines are refcounted, yes */	268	int refcnt; /* coroutines are refcounted, yes */
…		…
282	struct coro next, prev;	283	struct coro next, prev;
283	};	284	};
284		285
285	typedef struct coro *Coro__State;	286	typedef struct coro *Coro__State;
286	typedef struct coro *Coro__State_or_hashref;	287	typedef struct coro *Coro__State_or_hashref;
		288
		289	static struct CoroSLF slf_frame; /* the current slf frame */
287		290
288	/ Coro ******************************************************************/	291	/ Coro ******************************************************************/
289		292
290	#define PRIO_MAX 3	293	#define PRIO_MAX 3
291	#define PRIO_HIGH 1	294	#define PRIO_HIGH 1
…		…
296		299
297	/* for Coro.pm */	300	/* for Coro.pm */
298	static SV *coro_current;	301	static SV *coro_current;
299	static SV *coro_readyhook;	302	static SV *coro_readyhook;
300	static AV *coro_ready [PRIO_MAX - PRIO_MIN + 1];	303	static AV *coro_ready [PRIO_MAX - PRIO_MIN + 1];
301	static int coro_nready;
302	static struct coro *coro_first;	304	static struct coro *coro_first;
		305	#define coro_nready coroapi.nready
303		306
304	/ lowlevel stuff ********************************************************/	307	/ lowlevel stuff ********************************************************/
305		308
306	static SV *	309	static SV *
307	coro_get_sv (pTHX_ const char *name, int create)	310	coro_get_sv (pTHX_ const char *name, int create)
…		…
511	CvPADLIST (cv) = (AV *)POPs;	514	CvPADLIST (cv) = (AV *)POPs;
512	}	515	}
513		516
514	PUTBACK;	517	PUTBACK;
515	}	518	}
		519
		520	slf_frame = c->slf_frame;
516	}	521	}
517		522
518	static void	523	static void
519	save_perl (pTHX_ Coro__State c)	524	save_perl (pTHX_ Coro__State c)
520	{	525	{
		526	c->slf_frame = slf_frame;
		527
521	{	528	{
522	dSP;	529	dSP;
523	I32 cxix = cxstack_ix;	530	I32 cxix = cxstack_ix;
524	PERL_CONTEXT *ccstk = cxstack;	531	PERL_CONTEXT *ccstk = cxstack;
525	PERL_SI *top_si = PL_curstackinfo;	532	PERL_SI *top_si = PL_curstackinfo;
…		…
592	#undef VAR	599	#undef VAR
593	}	600	}
594	}	601	}
595		602
596	/*	603	/*
597	* allocate various perl stacks. This is an exact copy	604	* allocate various perl stacks. This is almost an exact copy
598	* of perl.c:init_stacks, except that it uses less memory	605	* of perl.c:init_stacks, except that it uses less memory
599	* on the (sometimes correct) assumption that coroutines do	606	* on the (sometimes correct) assumption that coroutines do
600	* not usually need a lot of stackspace.	607	* not usually need a lot of stackspace.
601	*/	608	*/
602	#if CORO_PREFER_PERL_FUNCTIONS	609	#if CORO_PREFER_PERL_FUNCTIONS
…		…
723	#ifndef MgPV_nolen_const	730	#ifndef MgPV_nolen_const
724	#define MgPV_nolen_const(mg) (((((int)(mg)->mg_len)) == HEf_SVKEY) ? \	731	#define MgPV_nolen_const(mg) (((((int)(mg)->mg_len)) == HEf_SVKEY) ? \
725	SvPV_nolen((SV*)((mg)->mg_ptr)) : \	732	SvPV_nolen((SV*)((mg)->mg_ptr)) : \
726	(const char*)(mg)->mg_ptr)	733	(const char*)(mg)->mg_ptr)
727	#endif	734	#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		735
734	/*	736	/*
735	* This overrides the default magic get method of %SIG elements.	737	* 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	738	* 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	739	* and instead of tryign to save and restore the hash elements, we just provide
…		…
809		811
810	return orig_sigelem_set ? orig_sigelem_set (aTHX_ sv, mg) : 0;	812	return orig_sigelem_set ? orig_sigelem_set (aTHX_ sv, mg) : 0;
811	}	813	}
812		814
813	static void	815	static void
		816	prepare_nop (aTHX_ struct coro_transfer_args *ta)
		817	{
		818	/* kind of mega-hacky, but works */
		819	ta->next = ta->prev = (struct coro *)ta;
		820	}
		821
		822	static int
		823	slf_check_nop (aTHX)
		824	{
		825	return 0;
		826	}
		827
		828	static void
814	coro_setup (pTHX_ struct coro *coro)	829	coro_setup (pTHX_ struct coro *coro)
815	{	830	{
816	/*	831	/*
817	* emulate part of the perl startup here.	832	* emulate part of the perl startup here.
818	*/	833	*/
…		…
857	PL_op = PL_ppaddr[OP_ENTERSUB](aTHX);	872	PL_op = PL_ppaddr[OP_ENTERSUB](aTHX);
858	SPAGAIN;	873	SPAGAIN;
859	}	874	}
860		875
861	/* this newly created coroutine might be run on an existing cctx which most	876	/* this newly created coroutine might be run on an existing cctx which most
862	* likely was suspended in set_stacklevel, called from entersub.	877	* 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	*/	878	*/
866	SSL_HEAD;	879	slf_frame.prepare = prepare_nop; /* provide a nop function for an eventual pp_slf */
		880	slf_frame.check = slf_check_nop; /* signal pp_slf to not repeat */
867	}	881	}
868		882
869	static void	883	static void
870	coro_destruct (pTHX_ struct coro *coro)	884	coro_destruct (pTHX_ struct coro *coro)
871	{	885	{
…		…
1035	TAINT_NOT;	1049	TAINT_NOT;
1036	return 0;	1050	return 0;
1037	}	1051	}
1038		1052
1039	static void	1053	static void
1040	prepare_set_stacklevel (struct transfer_args ta, struct coro_cctx cctx)	1054	prepare_set_stacklevel (struct coro_transfer_args ta, struct coro_cctx cctx)
1041	{	1055	{
1042	ta->prev = (struct coro *)cctx;	1056	ta->prev = (struct coro *)cctx;
1043	ta->next = 0;	1057	ta->next = 0;
1044	}	1058	}
1045		1059
…		…
1105	# endif	1119	# endif
1106	#endif	1120	#endif
1107	{	1121	{
1108	dTHX;	1122	dTHX;
1109		1123
1110	/* entersub called ENTER, but we never 'returned', undo that here */	1124	/* normally we would need to skip the entersub here */
1111	SSL_TAIL;	1125	/* 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;	1126	/* PL_nop = PL_nop->op_next */
1115		1127
1116	/* inject a fake subroutine call to cctx_init */	1128	/* inject a fake subroutine call to cctx_init */
1117	cctx_prepare (aTHX_ (coro_cctx *)arg);	1129	cctx_prepare (aTHX_ (coro_cctx *)arg);
1118		1130
1119	/* cctx_run is the alternative tail of transfer() */	1131	/* cctx_run is the alternative tail of transfer() */
		1132	/* TODO: throwing an exception here might be deadly, VERIFY */
1120	transfer_tail (aTHX);	1133	transfer_tail (aTHX);
1121		1134
1122	/* somebody or something will hit me for both perl_run and PL_restartop */	1135	/* somebody or something will hit me for both perl_run and PL_restartop */
1123	PL_restartop = PL_op;	1136	PL_restartop = PL_op;
1124	perl_run (PL_curinterp);	1137	perl_run (PL_curinterp);
…		…
1283	transfer_check (pTHX_ struct coro prev, struct coro next)	1296	transfer_check (pTHX_ struct coro prev, struct coro next)
1284	{	1297	{
1285	if (expect_true (prev != next))	1298	if (expect_true (prev != next))
1286	{	1299	{
1287	if (expect_false (!(prev->flags & (CF_RUNNING \| CF_NEW))))	1300	if (expect_false (!(prev->flags & (CF_RUNNING \| CF_NEW))))
1288	croak ("Coro::State::transfer called with non-running/new prev Coro::State, but can only transfer from running or new states");	1301	croak ("Coro::State::transfer called with non-running/new prev Coro::State, but can only transfer from running or new states,");
1289		1302
1290	if (expect_false (next->flags & CF_RUNNING))	1303	if (expect_false (next->flags & CF_RUNNING))
1291	croak ("Coro::State::transfer called with running next Coro::State, but can only transfer to inactive states");	1304	croak ("Coro::State::transfer called with running next Coro::State, but can only transfer to inactive states,");
1292		1305
1293	if (expect_false (next->flags & CF_DESTROYED))	1306	if (expect_false (next->flags & CF_DESTROYED))
1294	croak ("Coro::State::transfer called with destroyed next Coro::State, but can only transfer to inactive states");	1307	croak ("Coro::State::transfer called with destroyed next Coro::State, but can only transfer to inactive states,");
1295		1308
1296	#if !PERL_VERSION_ATLEAST (5,10,0)	1309	#if !PERL_VERSION_ATLEAST (5,10,0)
1297	if (expect_false (PL_lex_state != LEX_NOTPARSING))	1310	if (expect_false (PL_lex_state != LEX_NOTPARSING))
1298	croak ("Coro::State::transfer called while parsing, but this is not supported in your perl version");	1311	croak ("Coro::State::transfer called while parsing, but this is not supported in your perl version,");
1299	#endif	1312	#endif
1300	}	1313	}
1301	}	1314	}
1302		1315
1303	/* always use the TRANSFER macro */	1316	/* always use the TRANSFER macro */
…		…
1307	dSTACKLEVEL;	1320	dSTACKLEVEL;
1308		1321
1309	/* sometimes transfer is only called to set idle_sp */	1322	/* sometimes transfer is only called to set idle_sp */
1310	if (expect_false (!next))	1323	if (expect_false (!next))
1311	{	1324	{
1312	((coro_cctx *)prev)->idle_sp = STACKLEVEL;	1325	((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 */	1326	assert (((coro_cctx )prev)->idle_te = PL_top_env); / just for the side-effect when asserts are enabled */
1314	}	1327	}
1315	else if (expect_true (prev != next))	1328	else if (expect_true (prev != next))
1316	{	1329	{
1317	coro_cctx *prev__cctx;	1330	coro_cctx *prev__cctx;
…		…
1344		1357
1345	prev__cctx = prev->cctx;	1358	prev__cctx = prev->cctx;
1346		1359
1347	/* possibly untie and reuse the cctx */	1360	/* possibly untie and reuse the cctx */
1348	if (expect_true (	1361	if (expect_true (
1349	prev__cctx->idle_sp == STACKLEVEL	1362	prev__cctx->idle_sp == stacklevel
1350	&& !(prev__cctx->flags & CC_TRACE)	1363	&& !(prev__cctx->flags & CC_TRACE)
1351	&& !force_cctx	1364	&& !force_cctx
1352	))	1365	))
1353	{	1366	{
1354	/* I assume that STACKLEVEL is a stronger indicator than PL_top_env changes */	1367	/* 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));	1368	assert (("FATAL: current top_env must equal previous top_env in Coro (please report)", PL_top_env == prev__cctx->idle_te));
1356		1369
1357	prev->cctx = 0;	1370	prev->cctx = 0;
1358		1371
1359	/* if the cctx is about to be destroyed we need to make sure we won't see it in cctx_get */	1372	/* if the cctx is about to be destroyed we need to make sure we won't see it in cctx_get */
…		…
1410		1423
1411	if (coro->mainstack && coro->mainstack != main_mainstack)	1424	if (coro->mainstack && coro->mainstack != main_mainstack)
1412	{	1425	{
1413	struct coro temp;	1426	struct coro temp;
1414		1427
1415	if (coro->flags & CF_RUNNING)	1428	assert (("FATAL: tried to destroy currently running coroutine (please report)", !(coro->flags & CF_RUNNING)));
1416	croak ("FATAL: tried to destroy currently running coroutine");
1417		1429
1418	save_perl (aTHX_ &temp);	1430	save_perl (aTHX_ &temp);
1419	load_perl (aTHX_ coro);	1431	load_perl (aTHX_ coro);
1420		1432
1421	coro_destruct (aTHX_ coro);	1433	coro_destruct (aTHX_ coro);
…		…
1472	# define MGf_DUP 0	1484	# define MGf_DUP 0
1473	#endif	1485	#endif
1474	};	1486	};
1475		1487
1476	static void	1488	static void
1477	prepare_transfer (pTHX_ struct transfer_args ta, SV prev_sv, SV *next_sv)	1489	prepare_transfer (pTHX_ struct coro_transfer_args ta, SV prev_sv, SV *next_sv)
1478	{	1490	{
1479	ta->prev = SvSTATE (prev_sv);	1491	ta->prev = SvSTATE (prev_sv);
1480	ta->next = SvSTATE (next_sv);	1492	ta->next = SvSTATE (next_sv);
1481	TRANSFER_CHECK (*ta);	1493	TRANSFER_CHECK (*ta);
1482	}	1494	}
1483		1495
1484	static void	1496	static void
1485	api_transfer (SV prev_sv, SV next_sv)	1497	api_transfer (pTHX_ SV prev_sv, SV next_sv)
1486	{	1498	{
1487	dTHX;
1488	struct transfer_args ta;	1499	struct coro_transfer_args ta;
1489		1500
1490	prepare_transfer (aTHX_ &ta, prev_sv, next_sv);	1501	prepare_transfer (aTHX_ &ta, prev_sv, next_sv);
1491	TRANSFER (ta, 1);	1502	TRANSFER (ta, 1);
1492	}	1503	}
1493		1504
…		…
1510		1521
1511	return 0;	1522	return 0;
1512	}	1523	}
1513		1524
1514	static int	1525	static int
1515	api_ready (SV *coro_sv)	1526	api_ready (pTHX_ SV *coro_sv)
1516	{	1527	{
1517	dTHX;
1518	struct coro *coro;	1528	struct coro *coro;
1519	SV *sv_hook;	1529	SV *sv_hook;
1520	void (*xs_hook)(void);	1530	void (*xs_hook)(void);
1521		1531
1522	if (SvROK (coro_sv))	1532	if (SvROK (coro_sv))
…		…
1560		1570
1561	return 1;	1571	return 1;
1562	}	1572	}
1563		1573
1564	static int	1574	static int
1565	api_is_ready (SV *coro_sv)	1575	api_is_ready (pTHX_ SV *coro_sv)
1566	{	1576	{
1567	dTHX;
1568
1569	return !!(SvSTATE (coro_sv)->flags & CF_READY);	1577	return !!(SvSTATE (coro_sv)->flags & CF_READY);
1570	}	1578	}
1571		1579
1572	INLINE void	1580	INLINE void
1573	prepare_schedule (pTHX_ struct transfer_args *ta)	1581	prepare_schedule (pTHX_ struct coro_transfer_args *ta)
1574	{	1582	{
1575	SV prev_sv, next_sv;	1583	SV prev_sv, next_sv;
1576		1584
1577	for (;;)	1585	for (;;)
1578	{	1586	{
…		…
1627	coro_mortal = prev_sv;	1635	coro_mortal = prev_sv;
1628	UNLOCK;	1636	UNLOCK;
1629	}	1637	}
1630		1638
1631	INLINE void	1639	INLINE void
1632	prepare_cede (pTHX_ struct transfer_args *ta)	1640	prepare_cede (pTHX_ struct coro_transfer_args *ta)
1633	{	1641	{
1634	api_ready (coro_current);	1642	api_ready (aTHX_ coro_current);
1635	prepare_schedule (aTHX_ ta);	1643	prepare_schedule (aTHX_ ta);
1636	}	1644	}
1637		1645
		1646	INLINE void
		1647	prepare_cede_notself (pTHX_ struct coro_transfer_args *ta)
		1648	{
		1649	SV *prev = SvRV (coro_current);
		1650
		1651	if (coro_nready)
		1652	{
		1653	prepare_schedule (aTHX_ ta);
		1654	api_ready (aTHX_ prev);
		1655	}
		1656	else
		1657	prepare_nop (aTHX_ ta);
		1658	}
		1659
		1660	static void
		1661	api_schedule (pTHX)
		1662	{
		1663	struct coro_transfer_args ta;
		1664
		1665	prepare_schedule (aTHX_ &ta);
		1666	TRANSFER (ta, 1);
		1667	}
		1668
1638	static int	1669	static int
1639	prepare_cede_notself (pTHX_ struct transfer_args *ta)	1670	api_cede (pTHX)
1640	{	1671	{
1641	if (coro_nready)	1672	struct coro_transfer_args ta;
1642	{	1673
1643	SV *prev = SvRV (coro_current);
1644	prepare_schedule (aTHX_ ta);	1674	prepare_cede (aTHX_ &ta);
1645	api_ready (prev);	1675
		1676	if (expect_true (ta.prev != ta.next))
		1677	{
		1678	TRANSFER (ta, 1);
1646	return 1;	1679	return 1;
1647	}	1680	}
1648	else	1681	else
1649	return 0;	1682	return 0;
1650	}	1683	}
1651		1684
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	1685	static int
1663	api_cede (void)	1686	api_cede_notself (pTHX)
1664	{	1687	{
1665	dTHX;	1688	if (coro_nready)
		1689	{
1666	struct transfer_args ta;	1690	struct coro_transfer_args ta;
1667		1691
1668	prepare_cede (aTHX_ &ta);	1692	prepare_cede_notself (aTHX_ &ta);
1669
1670	if (expect_true (ta.prev != ta.next))
1671	{
1672	TRANSFER (ta, 1);	1693	TRANSFER (ta, 1);
1673	return 1;	1694	return 1;
1674	}	1695	}
1675	else	1696	else
1676	return 0;	1697	return 0;
1677	}	1698	}
1678		1699
1679	static int	1700	static void
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
1695	api_trace (SV *coro_sv, int flags)	1701	api_trace (pTHX_ SV *coro_sv, int flags)
1696	{	1702	{
1697	dTHX;
1698	struct coro *coro = SvSTATE (coro_sv);	1703	struct coro *coro = SvSTATE (coro_sv);
1699		1704
1700	if (flags & CC_TRACE)	1705	if (flags & CC_TRACE)
1701	{	1706	{
1702	if (!coro->cctx)	1707	if (!coro->cctx)
1703	coro->cctx = cctx_new_run ();	1708	coro->cctx = cctx_new_run ();
1704	else if (!(coro->cctx->flags & CC_TRACE))	1709	else if (!(coro->cctx->flags & CC_TRACE))
1705	croak ("cannot enable tracing on coroutine with custom stack");	1710	croak ("cannot enable tracing on coroutine with custom stack,");
1706		1711
1707	coro->cctx->flags \|= CC_NOREUSE \| (flags & (CC_TRACE \| CC_TRACE_ALL));	1712	coro->cctx->flags \|= CC_NOREUSE \| (flags & (CC_TRACE \| CC_TRACE_ALL));
1708	}	1713	}
1709	else if (coro->cctx && coro->cctx->flags & CC_TRACE)	1714	else if (coro->cctx && coro->cctx->flags & CC_TRACE)
1710	{	1715	{
…		…
1769	PerlIOCede *self = PerlIOSelf (f, PerlIOCede);	1774	PerlIOCede *self = PerlIOSelf (f, PerlIOCede);
1770	double now = nvtime ();	1775	double now = nvtime ();
1771		1776
1772	if (now >= self->next)	1777	if (now >= self->next)
1773	{	1778	{
1774	api_cede ();	1779	api_cede (aTHX);
1775	self->next = now + self->every;	1780	self->next = now + self->every;
1776	}	1781	}
1777		1782
1778	return PerlIOBuf_flush (aTHX_ f);	1783	return PerlIOBuf_flush (aTHX_ f);
1779	}	1784	}
…		…
1810	PerlIOBuf_set_ptrcnt,	1815	PerlIOBuf_set_ptrcnt,
1811	};	1816	};
1812		1817
1813	/*****************************************************************************/	1818	/*****************************************************************************/
1814		1819
1815	static const CV ssl_cv; / for quick consistency check */	1820	static const CV slf_cv; / for quick consistency check */
1816		1821
1817	static UNOP ssl_restore; /* restore stack as entersub did, for first-re-run */	1822	static UNOP slf_restore; /* restore stack as entersub did, for first-re-run */
1818	static SV *ssl_arg0;	1823	static SV *slf_arg0;
1819	static SV *ssl_arg1;	1824	static SV *slf_arg1;
		1825	static SV *slf_arg2;
1820		1826
1821	/* this restores the stack in the case we patched the entersub, to */	1827	/* this restores the stack in the case we patched the entersub, to */
1822	/* recreate the stack frame as perl will on following calls */	1828	/* recreate the stack frame as perl will on following calls */
1823	/* since entersub cleared the stack */	1829	/* since entersub cleared the stack */
1824	static OP *	1830	static OP *
…		…
1827	dSP;	1833	dSP;
1828		1834
1829	PUSHMARK (SP);	1835	PUSHMARK (SP);
1830		1836
1831	EXTEND (SP, 3);	1837	EXTEND (SP, 3);
1832	if (ssl_arg0) PUSHs (sv_2mortal (ssl_arg0)), ssl_arg0 = 0;	1838	if (slf_arg0) PUSHs (sv_2mortal (slf_arg0));
1833	if (ssl_arg1) PUSHs (sv_2mortal (ssl_arg1)), ssl_arg1 = 0;	1839	if (slf_arg1) PUSHs (sv_2mortal (slf_arg1));
		1840	if (slf_arg2) PUSHs (sv_2mortal (slf_arg2));
1834	PUSHs ((SV *)CvGV (ssl_cv));	1841	PUSHs ((SV *)CvGV (slf_cv));
1835		1842
1836	RETURNOP (ssl_restore.op_first);	1843	RETURNOP (slf_restore.op_first);
1837	}	1844	}
1838		1845
1839	/* declare prototype */	1846	static void
1840	XS(XS_Coro__State__set_stacklevel);	1847	slf_prepare_set_stacklevel (pTHX_ struct coro_transfer_args *ta)
		1848	{
		1849	prepare_set_stacklevel (ta, (struct coro_cctx *)slf_frame.data);
		1850	}
1841		1851
		1852	static void
		1853	slf_init_set_stacklevel (pTHX_ struct CoroSLF frame, SV *arg, int items)
		1854	{
		1855	assert (("FATAL: set_stacklevel needs the coro cctx as sole argument", items == 1));
		1856
		1857	frame->prepare = slf_prepare_set_stacklevel;
		1858	frame->check = slf_check_nop;
		1859	frame->data = (void *)SvIV (arg [0]);
		1860	}
		1861
		1862	static void
		1863	slf_prepare_transfer (pTHX_ struct coro_transfer_args *ta)
		1864	{
		1865	SV arg = (SV )slf_frame.data;
		1866
		1867	prepare_transfer (ta, arg [0], arg [1]);
		1868	}
		1869
		1870	static void
		1871	slf_init_transfer (pTHX_ struct CoroSLF frame, SV *arg, int items)
		1872	{
		1873	if (items != 2)
		1874	croak ("Coro::State::transfer (prev, next) expects two arguments, not %d,", items);
		1875
		1876	frame->prepare = slf_prepare_transfer;
		1877	frame->check = slf_check_nop;
		1878	frame->data = (void )arg; / let's hope it will stay valid */
		1879	}
		1880
		1881	static void
		1882	slf_init_schedule (pTHX_ struct CoroSLF frame, SV *arg, int items)
		1883	{
		1884	frame->prepare = prepare_schedule;
		1885	frame->check = slf_check_nop;
		1886	}
		1887
		1888	static void
		1889	slf_init_cede (pTHX_ struct CoroSLF frame, SV *arg, int items)
		1890	{
		1891	frame->prepare = prepare_cede;
		1892	frame->check = slf_check_nop;
		1893	}
		1894
		1895	static void
		1896	slf_init_cede_notself (pTHX_ struct CoroSLF frame, SV *arg, int items)
		1897	{
		1898	frame->prepare = prepare_cede_notself;
		1899	frame->check = slf_check_nop;
		1900	}
		1901
		1902	/* we hijack an hopefully unused CV flag for our purposes */
		1903	#define CVf_SLF 0x4000
		1904
		1905	/*
		1906	* these not obviously related functions are all rolled into one
		1907	* function to increase chances that they all will call transfer with the same
		1908	* stack offset
		1909	* SLF stands for "schedule-like-function".
		1910	*/
1842	static OP *	1911	static OP *
1843	pp_set_stacklevel (pTHX)	1912	pp_slf (pTHX)
1844	{	1913	{
		1914	I32 checkmark; /* mark SP to see how many elements check has pushed */
		1915
		1916	/* set up the slf frame, unless it has already been set-up */
		1917	/* the latter happens when a new coro has been started */
		1918	/* or when a new cctx was attached to an existing coroutine */
		1919	if (expect_true (!slf_frame.prepare))
		1920	{
		1921	/* first iteration */
1845	dSP;	1922	dSP;
1846	struct transfer_args ta;
1847	SV **arg = PL_stack_base + TOPMARK + 1;	1923	SV **arg = PL_stack_base + TOPMARK + 1;
1848	int items = SP - arg; /* args without function object */	1924	int items = SP - arg; /* args without function object */
		1925	SV gv = sp;
1849		1926
1850	/* do a quick consistency check on the "function" object, and if it isn't */	1927	/* do a quick consistency check on the "function" object, and if it isn't */
1851	/* for us, divert to the real entersub */	1928	/* for us, divert to the real entersub */
1852	if (SvTYPE (sp) != SVt_PVGV \|\| CvXSUB (GvCV (sp)) != XS_Coro__State__set_stacklevel)	1929	if (SvTYPE (gv) != SVt_PVGV \|\| !(CvFLAGS (GvCV (gv)) & CVf_SLF))
1853	return PL_ppaddr[OP_ENTERSUB](aTHX);	1930	return PL_ppaddr[OP_ENTERSUB](aTHX);
1854		1931
1855	/* pop args */	1932	/* pop args */
1856	SP = PL_stack_base + POPMARK;	1933	SP = PL_stack_base + POPMARK;
1857		1934
1858	if (!(PL_op->op_flags & OPf_STACKED))	1935	if (!(PL_op->op_flags & OPf_STACKED))
1859	{	1936	{
1860	/* ampersand-form of call, use @_ instead of stack */	1937	/* ampersand-form of call, use @_ instead of stack */
1861	AV *av = GvAV (PL_defgv);	1938	AV *av = GvAV (PL_defgv);
1862	arg = AvARRAY (av);	1939	arg = AvARRAY (av);
1863	items = AvFILLp (av) + 1;	1940	items = AvFILLp (av) + 1;
		1941	}
		1942
		1943	PUTBACK;
		1944
		1945	((coro_slf_cb)CvXSUBANY (GvCV (gv)).any_ptr) (aTHX_ &slf_frame, arg, items);
		1946	}
		1947
		1948	/* now interpret the slf_frame */
		1949	/* we use a callback system not to make the code needlessly */
		1950	/* complicated, but so we can run multiple perl coros from one cctx */
		1951
		1952	do
		1953	{
		1954	struct coro_transfer_args ta;
		1955
		1956	slf_frame.prepare (aTHX_ &ta);
		1957	TRANSFER (ta, 0);
		1958
		1959	checkmark = PL_stack_sp - PL_stack_base;
		1960	}
		1961	while (slf_frame.check (aTHX_ &slf_frame));
		1962
		1963	{
		1964	dSP;
		1965	SV **bot = PL_stack_base + checkmark;
		1966	int gimme = GIMME_V;
		1967
		1968	slf_frame.prepare = 0; /* signal pp_slf that we need a new frame */
		1969
		1970	/* make sure we put something on the stack in scalar context */
		1971	if (gimme == G_SCALAR)
		1972	{
		1973	if (sp == bot)
		1974	XPUSHs (&PL_sv_undef);
		1975
		1976	SP = bot + 1;
1864	}	1977	}
1865		1978
1866	PUTBACK;	1979	PUTBACK;
1867	switch (PL_op->op_private & 7)
1868	{
1869	case 0:
1870	prepare_set_stacklevel (&ta, (struct coro_cctx *)SvIV (arg [0]));
1871	break;
1872
1873	case 1:
1874	if (items != 2)
1875	croak ("Coro::State::transfer (prev, next) expects two arguments, not %d.", items);
1876
1877	prepare_transfer (aTHX_ &ta, arg [0], arg [1]);
1878	break;
1879
1880	case 2:
1881	prepare_schedule (aTHX_ &ta);
1882	break;
1883
1884	case 3:
1885	prepare_cede (aTHX_ &ta);
1886	break;
1887
1888	case 4:
1889	if (!prepare_cede_notself (aTHX_ &ta))
1890	RETURN;
1891
1892	break;
1893	}	1980	}
1894		1981
1895	TRANSFER (ta, 0);	1982	return NORMAL;
1896	SPAGAIN;	1983	}
1897		1984
1898	skip:	1985	static void
		1986	api_execute_slf (pTHX_ CV cv, coro_slf_cb init_cb, SV *arg, int items)
		1987	{
		1988	assert (("FATAL: SLF call with illegal CV value", !CvANON (cv)));
1899		1989
1900	RETURN;	1990	if (PL_op->op_ppaddr != PL_ppaddr [OP_ENTERSUB]
		1991	&& PL_op->op_ppaddr != pp_slf)
		1992	croak ("FATAL: Coro SLF calls can only be made normally, not via goto or other means, caught");
		1993
		1994	if (items > 3)
		1995	croak ("Coro only supports up to three arguments to SLF functions currently, caught");
		1996
		1997	CvFLAGS (cv) \|= CVf_SLF;
		1998	CvXSUBANY (cv).any_ptr = (void *)init_cb;
		1999	slf_cv = cv;
		2000
		2001	/* we patch the op, and then re-run the whole call */
		2002	/* we have to put the same argument on the stack for this to work */
		2003	/* and this will be done by pp_restore */
		2004	slf_restore.op_next = (OP *)&slf_restore;
		2005	slf_restore.op_type = OP_NULL;
		2006	slf_restore.op_ppaddr = pp_restore;
		2007	slf_restore.op_first = PL_op;
		2008
		2009	slf_arg0 = items > 0 ? SvREFCNT_inc (arg [0]) : 0;
		2010	slf_arg1 = items > 1 ? SvREFCNT_inc (arg [1]) : 0;
		2011	slf_arg2 = items > 2 ? SvREFCNT_inc (arg [2]) : 0;
		2012
		2013	PL_op->op_ppaddr = pp_slf;
		2014
		2015	PL_op = (OP *)&slf_restore;
1901	}	2016	}
1902		2017
1903	MODULE = Coro::State PACKAGE = Coro::State PREFIX = api_	2018	MODULE = Coro::State PACKAGE = Coro::State PREFIX = api_
1904		2019
1905	PROTOTYPES: DISABLE	2020	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		2021
1938	BOOT:	2022	BOOT:
1939	{	2023	{
1940	#ifdef USE_ITHREADS	2024	#ifdef USE_ITHREADS
1941	MUTEX_INIT (&coro_lock);	2025	MUTEX_INIT (&coro_lock);
…		…
1943	coro_thx = PERL_GET_CONTEXT;	2027	coro_thx = PERL_GET_CONTEXT;
1944	# endif	2028	# endif
1945	#endif	2029	#endif
1946	BOOT_PAGESIZE;	2030	BOOT_PAGESIZE;
1947		2031
1948	ssl_cv = get_cv ("Coro::State::_set_stacklevel", 0);
1949
1950	irsgv = gv_fetchpv ("/" , GV_ADD\|GV_NOTQUAL, SVt_PV);	2032	irsgv = gv_fetchpv ("/" , GV_ADD\|GV_NOTQUAL, SVt_PV);
1951	stdoutgv = gv_fetchpv ("STDOUT", GV_ADD\|GV_NOTQUAL, SVt_PVIO);	2033	stdoutgv = gv_fetchpv ("STDOUT", GV_ADD\|GV_NOTQUAL, SVt_PVIO);
1952		2034
1953	orig_sigelem_get = PL_vtbl_sigelem.svt_get; PL_vtbl_sigelem.svt_get = coro_sigelem_get;	2035	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;	2036	orig_sigelem_set = PL_vtbl_sigelem.svt_set; PL_vtbl_sigelem.svt_set = coro_sigelem_set;
…		…
1969	main_top_env = PL_top_env;	2051	main_top_env = PL_top_env;
1970		2052
1971	while (main_top_env->je_prev)	2053	while (main_top_env->je_prev)
1972	main_top_env = main_top_env->je_prev;	2054	main_top_env = main_top_env->je_prev;
1973		2055
1974	coroapi.ver = CORO_API_VERSION;	2056	coroapi.ver = CORO_API_VERSION;
1975	coroapi.rev = CORO_API_REVISION;	2057	coroapi.rev = CORO_API_REVISION;
		2058
1976	coroapi.transfer = api_transfer;	2059	coroapi.transfer = api_transfer;
		2060
		2061	coroapi.sv_state = SvSTATE_;
		2062	coroapi.execute_slf = api_execute_slf;
		2063	coroapi.prepare_nop = prepare_nop;
		2064	coroapi.prepare_schedule = prepare_schedule;
		2065	coroapi.prepare_cede = prepare_cede;
		2066	coroapi.prepare_cede_notself = prepare_cede_notself;
1977		2067
1978	{	2068	{
1979	SV **svp = hv_fetch (PL_modglobal, "Time::NVtime", 12, 0);	2069	SV **svp = hv_fetch (PL_modglobal, "Time::NVtime", 12, 0);
1980		2070
1981	if (!svp) croak ("Time::HiRes is required");	2071	if (!svp) croak ("Time::HiRes is required");
…		…
2013	for (i = 1; i < items; i++)	2103	for (i = 1; i < items; i++)
2014	av_push (coro->args, newSVsv (ST (i)));	2104	av_push (coro->args, newSVsv (ST (i)));
2015	}	2105	}
2016	OUTPUT:	2106	OUTPUT:
2017	RETVAL	2107	RETVAL
		2108
		2109	void
		2110	_set_stacklevel (...)
		2111	CODE:
		2112	api_execute_slf (aTHX_ cv, slf_init_set_stacklevel, &ST (0), items);
		2113
		2114	void
		2115	transfer (...)
		2116	CODE:
		2117	api_execute_slf (aTHX_ cv, slf_init_transfer, &ST (0), items);
2018		2118
2019	bool	2119	bool
2020	_destroy (SV *coro_sv)	2120	_destroy (SV *coro_sv)
2021	CODE:	2121	CODE:
2022	RETVAL = coro_state_destroy (aTHX_ SvSTATE (coro_sv));	2122	RETVAL = coro_state_destroy (aTHX_ SvSTATE (coro_sv));
…		…
2140	SvREFCNT_dec (self->throw);	2240	SvREFCNT_dec (self->throw);
2141	self->throw = SvOK (throw) ? newSVsv (throw) : 0;	2241	self->throw = SvOK (throw) ? newSVsv (throw) : 0;
2142		2242
2143	void	2243	void
2144	api_trace (SV *coro, int flags = CC_TRACE \| CC_TRACE_SUB)	2244	api_trace (SV *coro, int flags = CC_TRACE \| CC_TRACE_SUB)
		2245	C_ARGS: aTHX_ coro, flags
2145		2246
2146	SV *	2247	SV *
2147	has_cctx (Coro::State coro)	2248	has_cctx (Coro::State coro)
2148	PROTOTYPE: $	2249	PROTOTYPE: $
2149	CODE:	2250	CODE:
…		…
2184	PROTOTYPE: $	2285	PROTOTYPE: $
2185	ALIAS:	2286	ALIAS:
2186	swap_defav = 1	2287	swap_defav = 1
2187	CODE:	2288	CODE:
2188	if (!self->slot)	2289	if (!self->slot)
2189	croak ("cannot swap state with coroutine that has no saved state");	2290	croak ("cannot swap state with coroutine that has no saved state,");
2190	else	2291	else
2191	{	2292	{
2192	SV src = ix ? (SV )&GvAV (PL_defgv) : &GvSV (PL_defgv);	2293	SV src = ix ? (SV )&GvAV (PL_defgv) : &GvSV (PL_defgv);
2193	SV dst = ix ? (SV )&self->slot->defav : (SV **)&self->slot->defsv;	2294	SV dst = ix ? (SV )&self->slot->defav : (SV **)&self->slot->defsv;
2194		2295
…		…
2226	coroapi.schedule = api_schedule;	2327	coroapi.schedule = api_schedule;
2227	coroapi.cede = api_cede;	2328	coroapi.cede = api_cede;
2228	coroapi.cede_notself = api_cede_notself;	2329	coroapi.cede_notself = api_cede_notself;
2229	coroapi.ready = api_ready;	2330	coroapi.ready = api_ready;
2230	coroapi.is_ready = api_is_ready;	2331	coroapi.is_ready = api_is_ready;
2231	coroapi.nready = &coro_nready;	2332	coroapi.nready = coro_nready;
2232	coroapi.current = coro_current;	2333	coroapi.current = coro_current;
2233		2334
2234	GCoroAPI = &coroapi;	2335	GCoroAPI = &coroapi;
2235	sv_setiv (sv, (IV)&coroapi);	2336	sv_setiv (sv, (IV)&coroapi);
2236	SvREADONLY_on (sv);	2337	SvREADONLY_on (sv);
2237	}	2338	}
2238	}	2339	}
		2340
		2341	void
		2342	schedule (...)
		2343	CODE:
		2344	api_execute_slf (aTHX_ cv, slf_init_schedule, &ST (0), items);
		2345
		2346	void
		2347	cede (...)
		2348	CODE:
		2349	api_execute_slf (aTHX_ cv, slf_init_cede, &ST (0), items);
		2350
		2351	void
		2352	cede_notself (...)
		2353	CODE:
		2354	api_execute_slf (aTHX_ cv, slf_init_cede_notself, &ST (0), items);
2239		2355
2240	void	2356	void
2241	_set_current (SV *current)	2357	_set_current (SV *current)
2242	PROTOTYPE: $	2358	PROTOTYPE: $
2243	CODE:	2359	CODE:
…		…
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.273 by root, Fri Nov 14 23:48:10 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.273 by root, Fri Nov 14 23:48:10 2008 UTC