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

Comparing Coro/Coro/State.xs (file contents):
Revision 1.165 by root, Wed Sep 26 19:26:48 2007 UTC vs.
Revision 1.171 by root, Sat Sep 29 19:42:10 2007 UTC

…		…
141		141
142	static struct coro_cctx *cctx_first;	142	static struct coro_cctx *cctx_first;
143	static int cctx_count, cctx_idle;	143	static int cctx_count, cctx_idle;
144		144
145	enum {	145	enum {
146	CC_MAPPED = 0x01,	146	CC_MAPPED = 0x01,
147	CC_TRACE = 0x02,
148	CC_NOREUSE = 0x04, /* throw this away after tracing */	147	CC_NOREUSE = 0x02, /* throw this away after tracing */
		148	CC_TRACE = 0x04,
		149	CC_TRACE_SUB = 0x08, /* trace sub calls */
		150	CC_TRACE_LINE = 0x10, /* trace each statement */
		151	CC_TRACE_ALL = CC_TRACE_SUB \| CC_TRACE_LINE,
149	};	152	};
150		153
151	/* this is a structure representing a c-level coroutine */	154	/* this is a structure representing a c-level coroutine */
152	typedef struct coro_cctx {	155	typedef struct coro_cctx {
153	struct coro_cctx *next;	156	struct coro_cctx *next;
…		…
295	SvMAGIC (cv) \	298	SvMAGIC (cv) \
296	? SvMAGIC (cv)->mg_type == PERL_MAGIC_coro \	299	? SvMAGIC (cv)->mg_type == PERL_MAGIC_coro \
297	? SvMAGIC (cv) \	300	? SvMAGIC (cv) \
298	: mg_find ((SV *)cv, PERL_MAGIC_coro) \	301	: mg_find ((SV *)cv, PERL_MAGIC_coro) \
299	: 0	302	: 0
		303
		304	static struct coro *
		305	SvSTATE_ (pTHX_ SV *coro)
		306	{
		307	HV *stash;
		308	MAGIC *mg;
		309
		310	if (SvROK (coro))
		311	coro = SvRV (coro);
		312
		313	stash = SvSTASH (coro);
		314	if (stash != coro_stash && stash != coro_state_stash)
		315	{
		316	/* very slow, but rare, check */
		317	if (!sv_derived_from (sv_2mortal (newRV_inc (coro)), "Coro::State"))
		318	croak ("Coro::State object required");
		319	}
		320
		321	mg = CORO_MAGIC (coro);
		322	return (struct coro *)mg->mg_ptr;
		323	}
		324
		325	#define SvSTATE(sv) SvSTATE_ (aTHX_ (sv))
300		326
301	/* the next two functions merely cache the padlists */	327	/* the next two functions merely cache the padlists */
302	static void	328	static void
303	get_padlist (pTHX_ CV *cv)	329	get_padlist (pTHX_ CV *cv)
304	{	330	{
…		…
550	Safefree (PL_retstack);	576	Safefree (PL_retstack);
551	#endif	577	#endif
552	}	578	}
553		579
554	static size_t	580	static size_t
555	coro_rss (struct coro *coro)	581	coro_rss (pTHX_ struct coro *coro)
556	{	582	{
557	size_t rss = sizeof (coro);	583	size_t rss = sizeof (coro);
558		584
559	if (coro->mainstack)	585	if (coro->mainstack)
560	{	586	{
…		…
590	/*	616	/*
591	* emulate part of the perl startup here.	617	* emulate part of the perl startup here.
592	*/	618	*/
593	coro_init_stacks (aTHX);	619	coro_init_stacks (aTHX);
594		620
		621	PL_runops = RUNOPS_DEFAULT;
595	PL_curcop = &PL_compiling;	622	PL_curcop = &PL_compiling;
596	PL_in_eval = EVAL_NULL;	623	PL_in_eval = EVAL_NULL;
597	PL_comppad = 0;	624	PL_comppad = 0;
598	PL_curpm = 0;	625	PL_curpm = 0;
599	PL_localizing = 0;	626	PL_localizing = 0;
…		…
630	SvREFCNT_dec (coro_mortal);	657	SvREFCNT_dec (coro_mortal);
631	coro_mortal = 0;	658	coro_mortal = 0;
632	}	659	}
633	}	660	}
634		661
635	static void
636	do_trace (pTHX)
637	{
638	if (PL_curcop != &PL_compiling)
639	{
640	runops_proc_t old_runops = PL_runops;
641	dSP;
642	ENTER;
643	SAVETMPS;
644	PUSHMARK (SP);
645	PUTBACK;
646	PL_runops = RUNOPS_DEFAULT;
647	call_pv ("Coro::_do_trace", G_KEEPERR \| G_EVAL \| G_VOID \| G_DISCARD \| G_NOARGS);
648	PL_runops = old_runops;
649	SPAGAIN;
650	FREETMPS;
651	LEAVE;
652	PUTBACK;
653	}
654	}
655
656	static int	662	static int
657	runops_coro (pTHX)	663	runops_trace (pTHX)
658	{	664	{
659	COP *oldcop = 0;	665	COP *oldcop = 0;
		666	int oldcxix = -2;
		667	struct coro coro = SvSTATE (coro_current); / trace cctx is tied to specific coro */
		668	coro_cctx *cctx = coro->cctx;
660		669
661	while ((PL_op = CALL_FPTR (PL_op->op_ppaddr) (aTHX)))	670	while ((PL_op = CALL_FPTR (PL_op->op_ppaddr) (aTHX)))
662	{	671	{
663	PERL_ASYNC_CHECK ();	672	PERL_ASYNC_CHECK ();
		673
		674	if (PL_op->op_type == OP_LEAVESUB && cctx->flags & CC_TRACE_SUB)
		675	{
		676	PERL_CONTEXT *cx = &cxstack[cxstack_ix];
		677	SV bot, top;
		678	AV av = newAV (); / return values */
		679	SV **cb;
		680	runops_proc_t old_runops = PL_runops;
		681	dSP;
		682	ENTER;
		683	SAVETMPS;
		684	EXTEND (SP, 3);
		685	PL_runops = RUNOPS_DEFAULT;
		686
		687	GV *gv = CvGV (cx->blk_sub.cv);
		688	SV *fullname = sv_2mortal (newSV (0));
		689	if (isGV (gv))
		690	gv_efullname3 (fullname, gv, 0);
		691
		692	bot = PL_stack_base + cx->blk_oldsp + 1;
		693	top = cx->blk_gimme == G_ARRAY ? SP + 1
		694	: cx->blk_gimme == G_SCALAR ? bot + 1
		695	: bot;
		696
		697	while (bot < top)
		698	av_push (av, SvREFCNT_inc (*bot++));
		699
		700	PUSHMARK (SP);
		701	PUSHs (&PL_sv_no);
		702	PUSHs (fullname);
		703	PUSHs (sv_2mortal (newRV_noinc ((SV *)av)));
		704	PUTBACK;
		705	cb = hv_fetch ((HV *)SvRV (coro_current), "_trace_sub_cb", sizeof ("_trace_sub_cb") - 1, 0);
		706	if (cb) call_sv (*cb, G_KEEPERR \| G_EVAL \| G_VOID \| G_DISCARD);
		707	SPAGAIN;
		708
		709	FREETMPS;
		710	LEAVE;
		711	PL_runops = old_runops;
		712	}
664		713
665	if (oldcop != PL_curcop)	714	if (oldcop != PL_curcop)
666	{	715	{
667	oldcop = PL_curcop;	716	oldcop = PL_curcop;
668	do_trace (aTHX);	717
		718	if (PL_curcop != &PL_compiling)
		719	{
		720	SV **cb;
		721	runops_proc_t old_runops = PL_runops;
		722	dSP;
		723	ENTER;
		724	SAVETMPS;
		725	EXTEND (SP, 3);
		726	PL_runops = RUNOPS_DEFAULT;
		727
		728	if (oldcxix != cxstack_ix && cctx->flags & CC_TRACE_SUB)
		729	{
		730	PERL_CONTEXT *cx = &cxstack[cxstack_ix];
		731
		732	if (CxTYPE (cx) == CXt_SUB && oldcxix < cxstack_ix)
		733	{
		734	GV *gv = CvGV (cx->blk_sub.cv);
		735	SV *fullname = sv_2mortal (newSV (0));
		736	if (isGV (gv))
		737	gv_efullname3 (fullname, gv, 0);
		738
		739	PUSHMARK (SP);
		740	PUSHs (&PL_sv_yes);
		741	PUSHs (fullname);
		742	PUSHs (cx->blk_sub.hasargs ? sv_2mortal (newRV_inc ((SV *)cx->blk_sub.argarray)) : &PL_sv_undef);
		743	PUTBACK;
		744	cb = hv_fetch ((HV *)SvRV (coro_current), "_trace_sub_cb", sizeof ("_trace_sub_cb") - 1, 0);
		745	if (cb) call_sv (*cb, G_KEEPERR \| G_EVAL \| G_VOID \| G_DISCARD);
		746	SPAGAIN;
		747	}
		748
		749	oldcxix = cxstack_ix;
		750	}
		751
		752	if (cctx->flags & CC_TRACE_LINE)
		753	{
		754	PUSHMARK (SP);
		755	PUSHs (sv_2mortal (newSVpv (OutCopFILE (oldcop), 0)));
		756	PUSHs (sv_2mortal (newSViv (CopLINE (oldcop))));
		757	PUTBACK;
		758	cb = hv_fetch ((HV *)SvRV (coro_current), "_trace_line_cb", sizeof ("_trace_line_cb") - 1, 0);
		759	if (cb) call_sv (*cb, G_KEEPERR \| G_EVAL \| G_VOID \| G_DISCARD);
		760	SPAGAIN;
		761	}
		762
		763	FREETMPS;
		764	LEAVE;
		765	PL_runops = old_runops;
		766	}
669	}	767	}
670	}	768	}
671		769
672	TAINT_NOT;	770	TAINT_NOT;
673	return 0;	771	return 0;
…		…
683	LOGOP myop;	781	LOGOP myop;
684		782
685	PL_top_env = &PL_start_env;	783	PL_top_env = &PL_start_env;
686		784
687	if (cctx->flags & CC_TRACE)	785	if (cctx->flags & CC_TRACE)
688	PL_runops = runops_coro;	786	PL_runops = runops_trace;
689		787
690	Zero (&myop, 1, LOGOP);	788	Zero (&myop, 1, LOGOP);
691	myop.op_next = PL_op;	789	myop.op_next = PL_op;
692	myop.op_flags = OPf_WANT_VOID \| OPf_STACKED;	790	myop.op_flags = OPf_WANT_VOID \| OPf_STACKED;
693		791
…		…
839	cctx_first = cctx;	937	cctx_first = cctx;
840	}	938	}
841		939
842	/ coroutine switching ***************************************************/	940	/ coroutine switching ***************************************************/
843		941
844	/* never call directly, always through the coro_state_transfer global variable */	942	static void NOINLINE
		943	transfer_check (pTHX_ struct coro prev, struct coro next)
		944	{
		945	if (prev != next)
		946	{
		947	if (!(prev->flags & (CF_RUNNING \| CF_NEW)))
		948	croak ("Coro::State::transfer called with non-running/new prev Coro::State, but can only transfer from running or new states");
		949
		950	if (next->flags & CF_RUNNING)
		951	croak ("Coro::State::transfer called with running next Coro::State, but can only transfer to inactive states");
		952
		953	if (next->flags & CF_DESTROYED)
		954	croak ("Coro::State::transfer called with destroyed next Coro::State, but can only transfer to inactive states");
		955
		956	if (PL_lex_state != LEX_NOTPARSING)
		957	croak ("Coro::State::transfer called while parsing, but this is not supported");
		958	}
		959	}
		960
		961	/* always use the TRANSFER macro */
845	static void NOINLINE	962	static void NOINLINE
846	transfer (pTHX_ struct coro prev, struct coro next)	963	transfer (pTHX_ struct coro prev, struct coro next)
847	{	964	{
848	dSTACKLEVEL;	965	dSTACKLEVEL;
849		966
…		…
862	/* create a new empty context */	979	/* create a new empty context */
863	Newz (0, prev->cctx, 1, coro_cctx);	980	Newz (0, prev->cctx, 1, coro_cctx);
864	prev->flags &= ~CF_NEW;	981	prev->flags &= ~CF_NEW;
865	prev->flags \|= CF_RUNNING;	982	prev->flags \|= CF_RUNNING;
866	}	983	}
867
868	/TODO: must not croak here /
869	if (!prev->flags & CF_RUNNING)
870	croak ("Coro::State::transfer called with non-running prev Coro::State, but can only transfer from running states");
871
872	if (next->flags & CF_RUNNING)
873	croak ("Coro::State::transfer called with running next Coro::State, but can only transfer to inactive states");
874
875	if (next->flags & CF_DESTROYED)
876	croak ("Coro::State::transfer called with destroyed next Coro::State, but can only transfer to inactive states");
877		984
878	prev->flags &= ~CF_RUNNING;	985	prev->flags &= ~CF_RUNNING;
879	next->flags \|= CF_RUNNING;	986	next->flags \|= CF_RUNNING;
880		987
881	LOCK;	988	LOCK;
…		…
897	}	1004	}
898		1005
899	prev__cctx = prev->cctx;	1006	prev__cctx = prev->cctx;
900		1007
901	/* possibly "free" the cctx */	1008	/* possibly "free" the cctx */
902	if (prev__cctx->idle_sp == STACKLEVEL)	1009	if (prev__cctx->idle_sp == STACKLEVEL && !(prev__cctx->flags & CC_TRACE))
903	{	1010	{
904	/* I assume that STACKLEVEL is a stronger indicator than PL_top_env changes */	1011	/* I assume that STACKLEVEL is a stronger indicator than PL_top_env changes */
905	assert (("ERROR: current top_env must equal previous top_env", PL_top_env == prev__cctx->idle_te));	1012	assert (("ERROR: current top_env must equal previous top_env", PL_top_env == prev__cctx->idle_te));
906		1013
907	prev->cctx = 0;	1014	prev->cctx = 0;
…		…
928	{	1035	{
929	struct coro prev, next;	1036	struct coro prev, next;
930	};	1037	};
931		1038
932	#define TRANSFER(ta) transfer (aTHX_ (ta).prev, (ta).next)	1039	#define TRANSFER(ta) transfer (aTHX_ (ta).prev, (ta).next)
		1040	#define TRANSFER_CHECK(ta) transfer_check (aTHX_ (ta).prev, (ta).next)
933		1041
934	/ high level stuff ******************************************************/	1042	/ high level stuff ******************************************************/
935		1043
936	static int	1044	static int
937	coro_state_destroy (pTHX_ struct coro *coro)	1045	coro_state_destroy (pTHX_ struct coro *coro)
…		…
1020	#else	1128	#else
1021	# define MGf_DUP 0	1129	# define MGf_DUP 0
1022	#endif	1130	#endif
1023	};	1131	};
1024		1132
1025	static struct coro *
1026	SvSTATE_ (pTHX_ SV *coro)
1027	{
1028	HV *stash;
1029	MAGIC *mg;
1030
1031	if (SvROK (coro))
1032	coro = SvRV (coro);
1033
1034	stash = SvSTASH (coro);
1035	if (stash != coro_stash && stash != coro_state_stash)
1036	{
1037	/* very slow, but rare, check */
1038	if (!sv_derived_from (sv_2mortal (newRV_inc (coro)), "Coro::State"))
1039	croak ("Coro::State object required");
1040	}
1041
1042	mg = CORO_MAGIC (coro);
1043	return (struct coro *)mg->mg_ptr;
1044	}
1045
1046	#define SvSTATE(sv) SvSTATE_ (aTHX_ (sv))
1047
1048	static void	1133	static void
1049	prepare_transfer (pTHX_ struct transfer_args ta, SV prev_sv, SV *next_sv)	1134	prepare_transfer (pTHX_ struct transfer_args ta, SV prev_sv, SV *next_sv)
1050	{	1135	{
1051	ta->prev = SvSTATE (prev_sv);	1136	ta->prev = SvSTATE (prev_sv);
1052	ta->next = SvSTATE (next_sv);	1137	ta->next = SvSTATE (next_sv);
		1138	TRANSFER_CHECK (*ta);
1053	}	1139	}
1054		1140
1055	static void	1141	static void
1056	api_transfer (SV prev_sv, SV next_sv)	1142	api_transfer (SV prev_sv, SV next_sv)
1057	{	1143	{
…		…
1174	break;	1260	break;
1175	}	1261	}
1176		1262
1177	/* free this only after the transfer */	1263	/* free this only after the transfer */
1178	prev_sv = SvRV (coro_current);	1264	prev_sv = SvRV (coro_current);
1179	SvRV_set (coro_current, next_sv);
1180	ta->prev = SvSTATE (prev_sv);	1265	ta->prev = SvSTATE (prev_sv);
1181		1266	TRANSFER_CHECK (*ta);
1182	assert (ta->next->flags & CF_READY);	1267	assert (ta->next->flags & CF_READY);
1183	ta->next->flags &= ~CF_READY;	1268	ta->next->flags &= ~CF_READY;
		1269	SvRV_set (coro_current, next_sv);
1184		1270
1185	LOCK;	1271	LOCK;
1186	free_coro_mortal (aTHX);	1272	free_coro_mortal (aTHX);
1187	coro_mortal = prev_sv;	1273	coro_mortal = prev_sv;
1188	UNLOCK;	1274	UNLOCK;
…		…
1261	MUTEX_INIT (&coro_mutex);	1347	MUTEX_INIT (&coro_mutex);
1262	#endif	1348	#endif
1263	BOOT_PAGESIZE;	1349	BOOT_PAGESIZE;
1264		1350
1265	coro_state_stash = gv_stashpv ("Coro::State", TRUE);	1351	coro_state_stash = gv_stashpv ("Coro::State", TRUE);
		1352
		1353	newCONSTSUB (coro_state_stash, "CC_TRACE" , newSViv (CC_TRACE));
		1354	newCONSTSUB (coro_state_stash, "CC_TRACE_SUB" , newSViv (CC_TRACE_SUB));
		1355	newCONSTSUB (coro_state_stash, "CC_TRACE_LINE", newSViv (CC_TRACE_LINE));
		1356	newCONSTSUB (coro_state_stash, "CC_TRACE_ALL" , newSViv (CC_TRACE_ALL));
1266		1357
1267	newCONSTSUB (coro_state_stash, "SAVE_DEFAV", newSViv (CORO_SAVE_DEFAV));	1358	newCONSTSUB (coro_state_stash, "SAVE_DEFAV", newSViv (CORO_SAVE_DEFAV));
1268	newCONSTSUB (coro_state_stash, "SAVE_DEFSV", newSViv (CORO_SAVE_DEFSV));	1359	newCONSTSUB (coro_state_stash, "SAVE_DEFSV", newSViv (CORO_SAVE_DEFSV));
1269	newCONSTSUB (coro_state_stash, "SAVE_ERRSV", newSViv (CORO_SAVE_ERRSV));	1360	newCONSTSUB (coro_state_stash, "SAVE_ERRSV", newSViv (CORO_SAVE_ERRSV));
1270	newCONSTSUB (coro_state_stash, "SAVE_IRSSV", newSViv (CORO_SAVE_IRSSV));	1361	newCONSTSUB (coro_state_stash, "SAVE_IRSSV", newSViv (CORO_SAVE_IRSSV));
…		…
1477	RETVAL = boolSV (coro->flags & ix);	1568	RETVAL = boolSV (coro->flags & ix);
1478	OUTPUT:	1569	OUTPUT:
1479	RETVAL	1570	RETVAL
1480		1571
1481	void	1572	void
1482	trace (Coro::State coro, int enable = 0)	1573	trace (Coro::State coro, int flags = CC_TRACE \| CC_TRACE_SUB)
1483	CODE:	1574	CODE:
1484	if (enable)	1575	if (flags & CC_TRACE)
1485	{	1576	{
1486	if (coro->flags & CF_RUNNING)
1487	croak ("cannot enable tracing on running coroutine");
1488
1489	if (coro->cctx)	1577	if (!coro->cctx)
		1578	coro->cctx = cctx_new ();
		1579	else if (!(coro->cctx->flags & CC_TRACE))
1490	croak ("cannot enable tracing on coroutine with custom stack");	1580	croak ("cannot enable tracing on coroutine with custom stack");
1491		1581
1492	coro->cctx = cctx_new ();
1493	coro->cctx->flags \|= CC_TRACE;	1582	coro->cctx->flags \|= flags & (CC_TRACE \| CC_TRACE_ALL);
1494	}	1583	}
1495	else	1584	else
1496	if (coro->cctx && coro->cctx->flags & CC_TRACE)	1585	if (coro->cctx && coro->cctx->flags & CC_TRACE)
1497	{	1586	{
1498	coro->cctx->flags &= ~CC_TRACE;	1587	coro->cctx->flags &= ~(CC_TRACE \| CC_TRACE_ALL);
1499	coro->cctx->flags \|= CC_NOREUSE;	1588	coro->cctx->flags \|= CC_NOREUSE;
		1589
		1590	if (coro->flags & CF_RUNNING)
		1591	PL_runops = RUNOPS_DEFAULT;
		1592	else
		1593	coro->runops = RUNOPS_DEFAULT;
1500	}	1594	}
1501		1595
1502	SV *	1596	SV *
1503	has_stack (Coro::State coro)	1597	has_stack (Coro::State coro)
1504	PROTOTYPE: $	1598	PROTOTYPE: $
1505	CODE:	1599	CODE:
1506	RETVAL = boolSV (!!coro->cctx);	1600	RETVAL = boolSV (!!coro->cctx);
1507	OUTPUT:	1601	OUTPUT:
1508	RETVAL	1602	RETVAL
1509		1603
		1604	int
		1605	is_traced (Coro::State coro)
		1606	PROTOTYPE: $
		1607	CODE:
		1608	RETVAL = (coro->cctx ? coro->cctx->flags : 0) & CC_TRACE_ALL;
		1609	OUTPUT:
		1610	RETVAL
		1611
1510	IV	1612	IV
1511	rss (Coro::State coro)	1613	rss (Coro::State coro)
1512	PROTOTYPE: $	1614	PROTOTYPE: $
1513	CODE:	1615	CODE:
1514	RETVAL = coro_rss (coro);	1616	RETVAL = coro_rss (aTHX_ coro);
1515	OUTPUT:	1617	OUTPUT:
1516	RETVAL	1618	RETVAL
1517		1619
1518		1620
1519	MODULE = Coro::State PACKAGE = Coro	1621	MODULE = Coro::State PACKAGE = Coro
…		…
1642	{	1744	{
1643	struct coro *coro = SvSTATE (coro_current);	1745	struct coro *coro = SvSTATE (coro_current);
1644		1746
1645	sv_setsv (cb, &PL_sv_undef);	1747	sv_setsv (cb, &PL_sv_undef);
1646		1748
1647	if (coro_rss (coro) > SvIV (sv_pool_rss)	1749	if (coro_rss (aTHX_ coro) > SvIV (sv_pool_rss)
1648	\|\| av_len (av_async_pool) + 1 >= SvIV (sv_pool_size))	1750	\|\| av_len (av_async_pool) + 1 >= SvIV (sv_pool_size))
1649	croak ("\3terminate\2\n");	1751	croak ("\3terminate\2\n");
1650		1752
1651	av_clear (GvAV (PL_defgv));	1753	av_clear (GvAV (PL_defgv));
1652	hv_store ((HV *)SvRV (coro_current), "desc", sizeof ("desc") - 1,	1754	hv_store ((HV *)SvRV (coro_current), "desc", sizeof ("desc") - 1,

Diff Legend

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

Comparing Coro/Coro/State.xs (file contents): Revision 1.165 by root, Wed Sep 26 19:26:48 2007 UTC vs. Revision 1.171 by root, Sat Sep 29 19:42:10 2007 UTC

Diff Legend

Comparing Coro/Coro/State.xs (file contents):
Revision 1.165 by root, Wed Sep 26 19:26:48 2007 UTC vs.
Revision 1.171 by root, Sat Sep 29 19:42:10 2007 UTC