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

Comparing Coro/Coro/State.xs (file contents):
Revision 1.437 by root, Tue Nov 5 15:13:42 2013 UTC vs.
Revision 1.463 by root, Wed Jun 22 20:37:27 2016 UTC

…		…
14	#include "perliol.h"	14	#include "perliol.h"
15		15
16	#include "schmorp.h"	16	#include "schmorp.h"
17		17
18	#define ECB_NO_THREADS 1	18	#define ECB_NO_THREADS 1
		19	#define ECB_NO_LIBM 1
19	#include "ecb.h"	20	#include "ecb.h"
20		21
21	#include <stddef.h>	22	#include <stddef.h>
22	#include <stdio.h>	23	#include <stdio.h>
23	#include <errno.h>	24	#include <errno.h>
24	#include <assert.h>	25	#include <assert.h>
		26
		27	#ifndef SvREFCNT_dec_NN
		28	#define SvREFCNT_dec_NN(sv) SvREFCNT_dec (sv)
		29	#endif
		30
		31	#ifndef SvREFCNT_inc_NN
		32	#define SvREFCNT_inc_NN(sv) SvREFCNT_inc (sv)
		33	#endif
25		34
26	#ifndef SVs_PADSTALE	35	#ifndef SVs_PADSTALE
27	# define SVs_PADSTALE 0	36	# define SVs_PADSTALE 0
28	#endif	37	#endif
29		38
…		…
41	# define PadlistNAMES(pl) (*PadlistARRAY (pl))	50	# define PadlistNAMES(pl) (*PadlistARRAY (pl))
42	# define PadARRAY AvARRAY	51	# define PadARRAY AvARRAY
43	# define PadMAX AvFILLp	52	# define PadMAX AvFILLp
44	# define newPADLIST(var) ((var) = newAV (), av_extend (var, 1))	53	# define newPADLIST(var) ((var) = newAV (), av_extend (var, 1))
45	#endif	54	#endif
		55	#ifndef PadnamelistREFCNT
		56	# define PadnamelistREFCNT(pnl) SvREFCNT (pnl)
		57	#endif
		58	#ifndef PadnamelistREFCNT_dec
		59	# define PadnamelistREFCNT_dec(pnl) SvREFCNT_dec (pnl)
		60	#endif
46		61
47	/* 5.19.something has replaced SVt_BIND by SVt_INVLIST */	62	/* 5.19.something has replaced SVt_BIND by SVt_INVLIST */
48	/* we just alias it to SVt_IV, as that is sufficient for swap_sv for now */	63	/* we just alias it to SVt_IV, as that is sufficient for swap_sv for now */
49	#if PERL_VERSION_ATLEAST(5,19,0)	64	#if PERL_VERSION_ATLEAST(5,19,0)
50	# define SVt_BIND SVt_IV	65	# define SVt_BIND SVt_IV
…		…
125		140
126	static GV irsgv; / $/ */	141	static GV irsgv; / $/ */
127	static GV stdoutgv; / STDOUT /	142	static GV stdoutgv; / STDOUT /
128	static SV *rv_diehook;	143	static SV *rv_diehook;
129	static SV *rv_warnhook;	144	static SV *rv_warnhook;
130	static HV hv_sig; / %SIG */
131		145
132	/* async_pool helper stuff */	146	/* async_pool helper stuff */
133	static SV *sv_pool_rss;	147	static SV *sv_pool_rss;
134	static SV *sv_pool_size;	148	static SV *sv_pool_size;
135	static SV sv_async_pool_idle; / description string */	149	static SV sv_async_pool_idle; / description string */
…		…
241	SV *saved_deffh;	255	SV *saved_deffh;
242	SV *invoke_cb;	256	SV *invoke_cb;
243	AV *invoke_av;	257	AV *invoke_av;
244		258
245	/* on_enter/on_leave */	259	/* on_enter/on_leave */
246	AV *on_enter;	260	AV on_enter; AV on_enter_xs;
247	AV *on_leave;	261	AV on_leave; AV on_leave_xs;
248		262
249	/* swap_sv */	263	/* swap_sv */
250	AV *swap_sv;	264	AV *swap_sv;
251		265
252	/* times */	266	/* times */
…		…
488		502
489	return 0;	503	return 0;
490	}	504	}
491		505
492	ecb_inline struct coro *	506	ecb_inline struct coro *
493	SvSTATE_ (pTHX_ SV *coro)	507	SvSTATE_ (pTHX_ SV *coro_sv)
494	{	508	{
495	MAGIC *mg;	509	MAGIC *mg;
496		510
497	if (SvROK (coro))	511	if (SvROK (coro_sv))
498	coro = SvRV (coro);	512	coro_sv = SvRV (coro_sv);
499		513
500	mg = SvSTATEhv_p (aTHX_ coro);	514	mg = SvSTATEhv_p (aTHX_ coro_sv);
501	if (!mg)	515	if (!mg)
502	croak ("Coro::State object required");	516	croak ("Coro::State object required");
503		517
504	return (struct coro *)mg->mg_ptr;	518	return (struct coro *)mg->mg_ptr;
505	}	519	}
…		…
516	ecb_inline PADLIST *	530	ecb_inline PADLIST *
517	coro_derive_padlist (pTHX_ CV *cv)	531	coro_derive_padlist (pTHX_ CV *cv)
518	{	532	{
519	PADLIST *padlist = CvPADLIST (cv);	533	PADLIST *padlist = CvPADLIST (cv);
520	PADLIST *newpadlist;	534	PADLIST *newpadlist;
		535	PADNAMELIST *padnames;
521	PAD *newpad;	536	PAD *newpad;
522	PADOFFSET off = PadlistMAX (padlist) + 1;	537	PADOFFSET off = PadlistMAX (padlist) + 1;
523		538
524	#if NEWPADAPI	539	#if NEWPADAPI
525		540
…		…
552	AvREAL_off (newpadlist);	567	AvREAL_off (newpadlist);
553	#endif	568	#endif
554		569
555	/* Already extended to 2 elements by newPADLIST. */	570	/* Already extended to 2 elements by newPADLIST. */
556	PadlistMAX (newpadlist) = 1;	571	PadlistMAX (newpadlist) = 1;
557	PadlistNAMES (newpadlist) = (PADNAMELIST *)SvREFCNT_inc_NN (PadlistNAMES (padlist));	572
		573	padnames = PadlistNAMES (padlist);
		574	++PadnamelistREFCNT (padnames);
		575	PadlistNAMES (newpadlist) = padnames;
		576
558	PadlistARRAY (newpadlist)[1] = newpad;	577	PadlistARRAY (newpadlist)[1] = newpad;
559		578
560	return newpadlist;	579	return newpadlist;
561	}	580	}
562		581
…		…
570		589
571	while (i > 0) /* special-case index 0 */	590	while (i > 0) /* special-case index 0 */
572	{	591	{
573	/* we try to be extra-careful here */	592	/* we try to be extra-careful here */
574	PAD *pad = PadlistARRAY (padlist)[i--];	593	PAD *pad = PadlistARRAY (padlist)[i--];
		594
		595	if (pad)
		596	{
575	I32 j = PadMAX (pad);	597	I32 j = PadMAX (pad);
576		598
577	while (j >= 0)	599	while (j >= 0)
578	SvREFCNT_dec (PadARRAY (pad)[j--]);	600	SvREFCNT_dec (PadARRAY (pad)[j--]);
579		601
580	PadMAX (pad) = -1;	602	PadMAX (pad) = -1;
581	SvREFCNT_dec (pad);	603	SvREFCNT_dec (pad);
		604	}
582	}	605	}
583		606
584	SvREFCNT_dec (PadlistNAMES (padlist));	607	PadnamelistREFCNT_dec (PadlistNAMES (padlist));
585		608
586	#if NEWPADAPI	609	#if NEWPADAPI
587	Safefree (PadlistARRAY (padlist));	610	Safefree (PadlistARRAY (padlist));
588	Safefree (padlist);	611	Safefree (padlist);
589	#else	612	#else
…		…
685	tmp.sv_u = a->sv_u; a->sv_u = b->sv_u; b->sv_u = tmp.sv_u;	708	tmp.sv_u = a->sv_u; a->sv_u = b->sv_u; b->sv_u = tmp.sv_u;
686		709
687	/* if SvANY points to the head, we need to adjust the pointers,	710	/* if SvANY points to the head, we need to adjust the pointers,
688	* as the pointer for a still points to b, and maybe vice versa.	711	* as the pointer for a still points to b, and maybe vice versa.
689	*/	712	*/
690	#define svany_in_head(type) \	713	U32 svany_in_head_set = (1 << SVt_NULL) \| (1 << SVt_BIND) \| (1 << SVt_IV) \| (1 << SVt_RV);
691	(((1 << SVt_NULL) \| (1 << SVt_BIND) \| (1 << SVt_IV) \| (1 << SVt_RV)) & (1 << (type)))	714	#if NVSIZE <= IVSIZE && PERL_VERSION_ATLEAST(5,22,0)
		715	svany_in_head_set \|= 1 << SVt_NV;
		716	#endif
		717
		718	#define svany_in_head(type) (svany_in_head_set & (1 << (type)))
692		719
693	if (svany_in_head (SvTYPE (a)))	720	if (svany_in_head (SvTYPE (a)))
694	SvANY (a) = (void *)((PTRV)SvANY (a) - (PTRV)b + (PTRV)a);	721	SvANY (a) = (void *)((PTRV)SvANY (a) - (PTRV)b + (PTRV)a);
695		722
696	if (svany_in_head (SvTYPE (b)))	723	if (svany_in_head (SvTYPE (b)))
…		…
699	#endif	726	#endif
700	}	727	}
701		728
702	/* swap sv heads, at least logically */	729	/* swap sv heads, at least logically */
703	static void	730	static void
704	swap_svs (pTHX_ Coro__State c)	731	swap_svs_enter (pTHX_ Coro__State c)
705	{	732	{
706	int i;	733	int i;
707		734
708	for (i = 0; i <= AvFILLp (c->swap_sv); i += 2)	735	for (i = 0; i <= AvFILLp (c->swap_sv); i += 2)
709	swap_sv (AvARRAY (c->swap_sv)[i], AvARRAY (c->swap_sv)[i + 1]);	736	swap_sv (AvARRAY (c->swap_sv)[i], AvARRAY (c->swap_sv)[i + 1]);
710	}	737	}
711		738
		739	static void
		740	swap_svs_leave (pTHX_ Coro__State c)
		741	{
		742	int i;
		743
		744	for (i = AvFILLp (c->swap_sv) - 1; i >= 0; i -= 2)
		745	swap_sv (AvARRAY (c->swap_sv)[i], AvARRAY (c->swap_sv)[i + 1]);
		746	}
		747
712	#define SWAP_SVS(coro) \	748	#define SWAP_SVS_ENTER(coro) \
713	if (ecb_expect_false ((coro)->swap_sv)) \	749	if (ecb_expect_false ((coro)->swap_sv)) \
714	swap_svs (aTHX_ (coro))	750	swap_svs_enter (aTHX_ (coro))
		751
		752	#define SWAP_SVS_LEAVE(coro) \
		753	if (ecb_expect_false ((coro)->swap_sv)) \
		754	swap_svs_leave (aTHX_ (coro))
715		755
716	static void	756	static void
717	on_enterleave_call (pTHX_ SV *cb);	757	on_enterleave_call (pTHX_ SV *cb);
718		758
719	static void	759	static void
…		…
764		804
765	for (i = 0; i <= AvFILLp (c->on_enter); ++i)	805	for (i = 0; i <= AvFILLp (c->on_enter); ++i)
766	on_enterleave_call (aTHX_ AvARRAY (c->on_enter)[i]);	806	on_enterleave_call (aTHX_ AvARRAY (c->on_enter)[i]);
767	}	807	}
768		808
		809	if (ecb_expect_false (c->on_enter_xs))
		810	{
		811	int i;
		812
		813	for (i = 0; i <= AvFILLp (c->on_enter_xs); i += 2)
		814	((coro_enterleave_hook)AvARRAY (c->on_enter_xs)[i]) (aTHX_ AvARRAY (c->on_enter_xs)[i + 1]);
		815	}
		816
769	SWAP_SVS (c);	817	SWAP_SVS_ENTER (c);
770	}	818	}
771		819
772	static void	820	static void
773	save_perl (pTHX_ Coro__State c)	821	save_perl (pTHX_ Coro__State c)
774	{	822	{
775	SWAP_SVS (c);	823	SWAP_SVS_LEAVE (c);
		824
		825	if (ecb_expect_false (c->on_leave_xs))
		826	{
		827	int i;
		828
		829	for (i = AvFILLp (c->on_leave_xs) - 1; i >= 0; i -= 2)
		830	((coro_enterleave_hook)AvARRAY (c->on_leave_xs)[i]) (aTHX_ AvARRAY (c->on_leave_xs)[i + 1]);
		831	}
776		832
777	if (ecb_expect_false (c->on_leave))	833	if (ecb_expect_false (c->on_leave))
778	{	834	{
779	int i;	835	int i;
780		836
…		…
907	#endif	963	#endif
908		964
909	New(54,PL_savestack,24,ANY);	965	New(54,PL_savestack,24,ANY);
910	PL_savestack_ix = 0;	966	PL_savestack_ix = 0;
911	PL_savestack_max = 24;	967	PL_savestack_max = 24;
		968	#if !PERL_VERSION_ATLEAST (5,24,0)
		969	/* perl 5.24 moves SS_MAXPUSH optimisation from */
		970	/* the header macros to PL_savestack_max */
		971	PL_savestack_max -= SS_MAXPUSH;
		972	#endif
912		973
913	#if !PERL_VERSION_ATLEAST (5,10,0)	974	#if !PERL_VERSION_ATLEAST (5,10,0)
914	New(54,PL_retstack,4,OP*);	975	New(54,PL_retstack,4,OP*);
915	PL_retstack_ix = 0;	976	PL_retstack_ix = 0;
916	PL_retstack_max = 4;	977	PL_retstack_max = 4;
…		…
1133		1194
1134	GvSV (PL_defgv) = newSV (0);	1195	GvSV (PL_defgv) = newSV (0);
1135	GvAV (PL_defgv) = coro->args; coro->args = 0;	1196	GvAV (PL_defgv) = coro->args; coro->args = 0;
1136	GvSV (PL_errgv) = newSV (0);	1197	GvSV (PL_errgv) = newSV (0);
1137	GvSV (irsgv) = newSVpvn ("\n", 1); sv_magic (GvSV (irsgv), (SV *)irsgv, PERL_MAGIC_sv, "/", 0);	1198	GvSV (irsgv) = newSVpvn ("\n", 1); sv_magic (GvSV (irsgv), (SV *)irsgv, PERL_MAGIC_sv, "/", 0);
1138	GvHV (PL_hintgv) = 0;	1199	GvHV (PL_hintgv) = newHV ();
		1200	#if PERL_VERSION_ATLEAST (5,10,0)
		1201	hv_magic (GvHV (PL_hintgv), 0, PERL_MAGIC_hints);
		1202	#endif
1139	PL_rs = newSVsv (GvSV (irsgv));	1203	PL_rs = newSVsv (GvSV (irsgv));
1140	PL_defoutgv = (GV *)SvREFCNT_inc_NN (stdoutgv);	1204	PL_defoutgv = (GV *)SvREFCNT_inc_NN (stdoutgv);
1141		1205
1142	{	1206	{
1143	dSP;	1207	dSP;
…		…
1171	PL_op = (OP *)&init_perl_op;	1235	PL_op = (OP *)&init_perl_op;
1172		1236
1173	/* copy throw, in case it was set before init_perl */	1237	/* copy throw, in case it was set before init_perl */
1174	CORO_THROW = coro->except;	1238	CORO_THROW = coro->except;
1175		1239
1176	SWAP_SVS (coro);	1240	SWAP_SVS_ENTER (coro);
1177		1241
1178	if (ecb_expect_false (enable_times))	1242	if (ecb_expect_false (enable_times))
1179	{	1243	{
1180	coro_times_update ();	1244	coro_times_update ();
1181	coro_times_sub (coro);	1245	coro_times_sub (coro);
…		…
1219	/* this will cause transfer_check to croak on block*/	1283	/* this will cause transfer_check to croak on block*/
1220	SvRV_set (coro_current, (SV *)coro->hv);	1284	SvRV_set (coro_current, (SV *)coro->hv);
1221		1285
1222	load_perl (aTHX_ coro);	1286	load_perl (aTHX_ coro);
1223		1287
		1288	/* restore swapped sv's */
		1289	SWAP_SVS_LEAVE (coro);
		1290
1224	coro_unwind_stacks (aTHX);	1291	coro_unwind_stacks (aTHX);
1225
1226	/* restore swapped sv's */
1227	SWAP_SVS (coro);
1228		1292
1229	coro_destruct_stacks (aTHX);	1293	coro_destruct_stacks (aTHX);
1230		1294
1231	/* now save some sv's to be free'd later */	1295	/* now save some sv's to be free'd later */
1232	svf [0] = GvSV (PL_defgv);	1296	svf [0] = GvSV (PL_defgv);
…		…
1253		1317
1254	SvREFCNT_dec (coro->saved_deffh);	1318	SvREFCNT_dec (coro->saved_deffh);
1255	SvREFCNT_dec (coro->rouse_cb);	1319	SvREFCNT_dec (coro->rouse_cb);
1256	SvREFCNT_dec (coro->invoke_cb);	1320	SvREFCNT_dec (coro->invoke_cb);
1257	SvREFCNT_dec (coro->invoke_av);	1321	SvREFCNT_dec (coro->invoke_av);
		1322	SvREFCNT_dec (coro->on_enter_xs);
		1323	SvREFCNT_dec (coro->on_leave_xs);
1258	}	1324	}
1259	}	1325	}
1260		1326
1261	ecb_inline void	1327	ecb_inline void
1262	free_coro_mortal (pTHX)	1328	free_coro_mortal (pTHX)
…		…
1325		1391
1326	if (PL_curcop != &PL_compiling)	1392	if (PL_curcop != &PL_compiling)
1327	{	1393	{
1328	SV **cb;	1394	SV **cb;
1329		1395
1330	if (oldcxix != cxstack_ix && cctx_current->flags & CC_TRACE_SUB)	1396	if (oldcxix != cxstack_ix && cctx_current->flags & CC_TRACE_SUB && cxstack_ix >= 0)
1331	{	1397	{
1332	PERL_CONTEXT *cx = &cxstack[cxstack_ix];	1398	PERL_CONTEXT *cx = &cxstack[cxstack_ix];
1333		1399
1334	if (CxTYPE (cx) == CXt_SUB && oldcxix < cxstack_ix)	1400	if (CxTYPE (cx) == CXt_SUB && oldcxix < cxstack_ix)
1335	{	1401	{
…		…
1477	* coro body here, as perl_run destroys these. Likewise, we cannot catch	1543	* coro body here, as perl_run destroys these. Likewise, we cannot catch
1478	* runtime errors here, as this is just a random interpreter, not a thread.	1544	* runtime errors here, as this is just a random interpreter, not a thread.
1479	*/	1545	*/
1480		1546
1481	/*	1547	/*
		1548	* pp_entersub in 5.24 no longer ENTERs, but perl_destruct
		1549	* requires PL_scopestack_ix, so do it here if required.
		1550	*/
		1551	if (!PL_scopestack_ix)
		1552	ENTER;
		1553
		1554	/*
1482	* If perl-run returns we assume exit() was being called or the coro	1555	* If perl-run returns we assume exit() was being called or the coro
1483	* fell off the end, which seems to be the only valid (non-bug)	1556	* fell off the end, which seems to be the only valid (non-bug)
1484	* reason for perl_run to return. We try to mimic whatever perl is normally	1557	* reason for perl_run to return. We try to mimic whatever perl is normally
1485	* doing in that case. YMMV.	1558	* doing in that case. YMMV.
1486	*/	1559	*/
…		…
1912	/* nothing to schedule: call the idle handler */	1985	/* nothing to schedule: call the idle handler */
1913	if (SvROK (sv_idle)	1986	if (SvROK (sv_idle)
1914	&& SvOBJECT (SvRV (sv_idle)))	1987	&& SvOBJECT (SvRV (sv_idle)))
1915	{	1988	{
1916	if (SvRV (sv_idle) == SvRV (coro_current))	1989	if (SvRV (sv_idle) == SvRV (coro_current))
		1990	{
		1991	require_pv ("Carp");
		1992
		1993	{
		1994	dSP;
		1995
		1996	ENTER;
		1997	SAVETMPS;
		1998
		1999	PUSHMARK (SP);
1917	croak ("FATAL: $Coro::IDLE blocked itself - did you try to block inside an event loop callback? Caught");	2000	XPUSHs (sv_2mortal (newSVpv ("FATAL: $Coro::idle blocked itself - did you try to block inside an event loop callback? Caught", 0)));
		2001	PUTBACK;
		2002	call_pv ("Carp::confess", G_VOID \| G_DISCARD);
		2003
		2004	FREETMPS;
		2005	LEAVE;
		2006	}
		2007	}
1918		2008
1919	++coro_nready; /* hack so that api_ready doesn't invoke ready hook */	2009	++coro_nready; /* hack so that api_ready doesn't invoke ready hook */
1920	api_ready (aTHX_ SvRV (sv_idle));	2010	api_ready (aTHX_ SvRV (sv_idle));
1921	--coro_nready;	2011	--coro_nready;
1922	}	2012	}
…		…
2226	slf_init_terminate_cancel_common (aTHX_ frame, coro_hv);	2316	slf_init_terminate_cancel_common (aTHX_ frame, coro_hv);
2227	}	2317	}
2228	else	2318	else
2229	{	2319	{
2230	struct coro *self = SvSTATE_current;	2320	struct coro *self = SvSTATE_current;
		2321
		2322	if (!self)
		2323	croak ("Coro::cancel called outside of thread content,");
2231		2324
2232	/* otherwise we cancel directly, purely for speed reasons	2325	/* otherwise we cancel directly, purely for speed reasons
2233	* unfortunately, this requires some magic trickery, as	2326	* unfortunately, this requires some magic trickery, as
2234	* somebody else could cancel us, so we have to fight the cancellation.	2327	* somebody else could cancel us, so we have to fight the cancellation.
2235	* this is ugly, and hopefully fully worth the extra speed.	2328	* this is ugly, and hopefully fully worth the extra speed.
…		…
2345	else	2438	else
2346	{	2439	{
2347	av_clear (GvAV (PL_defgv));	2440	av_clear (GvAV (PL_defgv));
2348	hv_store (hv, "desc", sizeof ("desc") - 1, SvREFCNT_inc_NN (sv_async_pool_idle), 0);	2441	hv_store (hv, "desc", sizeof ("desc") - 1, SvREFCNT_inc_NN (sv_async_pool_idle), 0);
2349		2442
		2443	if (ecb_expect_false (coro->swap_sv))
		2444	{
		2445	swap_svs_leave (coro);
		2446	SvREFCNT_dec_NN (coro->swap_sv);
		2447	coro->swap_sv = 0;
		2448	}
		2449
2350	coro->prio = 0;	2450	coro->prio = 0;
2351		2451
2352	if (coro->cctx && (coro->cctx->flags & CC_TRACE))	2452	if (ecb_expect_false (coro->cctx) && ecb_expect_false (coro->cctx->flags & CC_TRACE))
2353	api_trace (aTHX_ coro_current, 0);	2453	api_trace (aTHX_ coro_current, 0);
2354		2454
2355	frame->prepare = prepare_schedule;	2455	frame->prepare = prepare_schedule;
2356	av_push (av_async_pool, SvREFCNT_inc (hv));	2456	av_push (av_async_pool, SvREFCNT_inc (hv));
2357	}	2457	}
…		…
2577		2677
2578	/* "undo"/cancel a running slf call - used when cancelling a coro, mainly */	2678	/* "undo"/cancel a running slf call - used when cancelling a coro, mainly */
2579	static void	2679	static void
2580	slf_destroy (pTHX_ struct coro *coro)	2680	slf_destroy (pTHX_ struct coro *coro)
2581	{	2681	{
2582	/* this callback is reserved for slf functions needing to do cleanup */	2682	struct CoroSLF frame = coro->slf_frame;
2583	if (coro->slf_frame.destroy && coro->slf_frame.prepare && !PL_dirty)
2584	coro->slf_frame.destroy (aTHX_ &coro->slf_frame);
2585		2683
2586	/*	2684	/*
2587	* The on_destroy above most likely is from an SLF call.	2685	* The on_destroy below most likely is from an SLF call.
2588	* Since by definition the SLF call will not finish when we destroy	2686	* Since by definition the SLF call will not finish when we destroy
2589	* the coro, we will have to force-finish it here, otherwise	2687	* the coro, we will have to force-finish it here, otherwise
2590	* cleanup functions cannot call SLF functions.	2688	* cleanup functions cannot call SLF functions.
2591	*/	2689	*/
2592	coro->slf_frame.prepare = 0;	2690	coro->slf_frame.prepare = 0;
		2691
		2692	/* this callback is reserved for slf functions needing to do cleanup */
		2693	if (frame.destroy && frame.prepare && !PL_dirty)
		2694	frame.destroy (aTHX_ &frame);
2593	}	2695	}
2594		2696
2595	/*	2697	/*
2596	* these not obviously related functions are all rolled into one	2698	* these not obviously related functions are all rolled into one
2597	* function to increase chances that they all will call transfer with the same	2699	* function to increase chances that they all will call transfer with the same
…		…
2780	static void	2882	static void
2781	coro_pop_on_leave (pTHX_ void *coro)	2883	coro_pop_on_leave (pTHX_ void *coro)
2782	{	2884	{
2783	SV cb = coro_avp_pop_and_free (aTHX_ &((struct coro )coro)->on_leave);	2885	SV cb = coro_avp_pop_and_free (aTHX_ &((struct coro )coro)->on_leave);
2784	on_enterleave_call (aTHX_ sv_2mortal (cb));	2886	on_enterleave_call (aTHX_ sv_2mortal (cb));
		2887	}
		2888
		2889	static void
		2890	enterleave_hook_xs (pTHX_ struct coro coro, AV avp, coro_enterleave_hook hook, void arg)
		2891	{
		2892	if (!hook)
		2893	return;
		2894
		2895	if (!*avp)
		2896	{
		2897	*avp = newAV ();
		2898	AvREAL_off (*avp);
		2899	}
		2900
		2901	av_push (avp, (SV )hook);
		2902	av_push (avp, (SV )arg);
		2903	}
		2904
		2905	static void
		2906	enterleave_unhook_xs (pTHX_ struct coro coro, AV *avp, coro_enterleave_hook hook, int execute)
		2907	{
		2908	AV av = avp;
		2909	int i;
		2910
		2911	if (!av)
		2912	return;
		2913
		2914	for (i = AvFILLp (av) - 1; i >= 0; i -= 2)
		2915	if (AvARRAY (av)[i] == (SV *)hook)
		2916	{
		2917	if (execute)
		2918	hook (aTHX_ (void *)AvARRAY (av)[i + 1]);
		2919
		2920	memmove (AvARRAY (av) + i, AvARRAY (av) + i + 2, AvFILLp (av) - i - 1);
		2921	av_pop (av);
		2922	av_pop (av);
		2923	break;
		2924	}
		2925
		2926	if (AvFILLp (av) >= 0)
		2927	{
		2928	*avp = 0;
		2929	SvREFCNT_dec_NN (av);
		2930	}
		2931	}
		2932
		2933	static void
		2934	api_enterleave_hook (pTHX_ SV coro_sv, coro_enterleave_hook enter, void enter_arg, coro_enterleave_hook leave, void *leave_arg)
		2935	{
		2936	struct coro *coro = SvSTATE (coro_sv);
		2937
		2938	if (SvSTATE_current == coro)
		2939	if (enter)
		2940	enter (aTHX_ enter_arg);
		2941
		2942	enterleave_hook_xs (aTHX_ coro, &coro->on_enter_xs, enter, enter_arg);
		2943	enterleave_hook_xs (aTHX_ coro, &coro->on_leave_xs, leave, leave_arg);
		2944	}
		2945
		2946	static void
		2947	api_enterleave_unhook (pTHX_ SV *coro_sv, coro_enterleave_hook enter, coro_enterleave_hook leave)
		2948	{
		2949	struct coro *coro = SvSTATE (coro_sv);
		2950
		2951	enterleave_unhook_xs (aTHX_ coro, &coro->on_enter_xs, enter, 0);
		2952	enterleave_unhook_xs (aTHX_ coro, &coro->on_leave_xs, leave, SvSTATE_current == coro);
		2953	}
		2954
		2955	static void
		2956	savedestructor_unhook_enter (pTHX_ coro_enterleave_hook enter)
		2957	{
		2958	struct coro *coro = SvSTATE_current;
		2959
		2960	enterleave_unhook_xs (aTHX_ coro, &coro->on_enter_xs, enter, 0);
		2961	}
		2962
		2963	static void
		2964	savedestructor_unhook_leave (pTHX_ coro_enterleave_hook leave)
		2965	{
		2966	struct coro *coro = SvSTATE_current;
		2967
		2968	enterleave_unhook_xs (aTHX_ coro, &coro->on_leave_xs, leave, 1);
		2969	}
		2970
		2971	static void
		2972	api_enterleave_scope_hook (pTHX_ coro_enterleave_hook enter, void enter_arg, coro_enterleave_hook leave, void leave_arg)
		2973	{
		2974	api_enterleave_hook (aTHX_ coro_current, enter, enter_arg, leave, leave_arg);
		2975
		2976	/* this ought to be much cheaper than malloc + a single destructor call */
		2977	if (enter) SAVEDESTRUCTOR_X (savedestructor_unhook_enter, enter);
		2978	if (leave) SAVEDESTRUCTOR_X (savedestructor_unhook_leave, leave);
2785	}	2979	}
2786		2980
2787	/*****************************************************************************/	2981	/*****************************************************************************/
2788	/* PerlIO::cede */	2982	/* PerlIO::cede */
2789		2983
…		…
2919	XPUSHs (sv_2mortal (newRV_inc ((SV *)av)));	3113	XPUSHs (sv_2mortal (newRV_inc ((SV *)av)));
2920	PUTBACK;	3114	PUTBACK;
2921	call_sv (cb, G_VOID \| G_DISCARD \| G_EVAL \| G_KEEPERR);	3115	call_sv (cb, G_VOID \| G_DISCARD \| G_EVAL \| G_KEEPERR);
2922	}	3116	}
2923		3117
2924	SvREFCNT_dec (cb);	3118	SvREFCNT_dec_NN (cb);
2925	}	3119	}
2926	}	3120	}
2927		3121
2928	static void	3122	static void
2929	coro_semaphore_destroy (pTHX_ struct CoroSLF *frame)	3123	coro_semaphore_destroy (pTHX_ struct CoroSLF *frame)
…		…
2937	{	3131	{
2938	AV av = (AV )frame->data;	3132	AV av = (AV )frame->data;
2939	SV *count_sv = AvARRAY (av)[0];	3133	SV *count_sv = AvARRAY (av)[0];
2940	SV *coro_hv = SvRV (coro_current);	3134	SV *coro_hv = SvRV (coro_current);
2941		3135
		3136	frame->destroy = 0;
		3137
2942	/* if we are about to throw, don't actually acquire the lock, just throw */	3138	/* if we are about to throw, don't actually acquire the lock, just throw */
2943	if (CORO_THROW)	3139	if (ecb_expect_false (CORO_THROW))
		3140	{
		3141	/* we still might be responsible for the semaphore, so wake up others */
		3142	coro_semaphore_adjust (aTHX_ av, 0);
		3143
2944	return 0;	3144	return 0;
		3145	}
2945	else if (SvIVX (count_sv) > 0)	3146	else if (SvIVX (count_sv) > 0)
2946	{	3147	{
2947	frame->destroy = 0;
2948
2949	if (acquire)	3148	if (acquire)
2950	SvIVX (count_sv) = SvIVX (count_sv) - 1;	3149	SvIVX (count_sv) = SvIVX (count_sv) - 1;
2951	else	3150	else
2952	coro_semaphore_adjust (aTHX_ av, 0);	3151	coro_semaphore_adjust (aTHX_ av, 0);
2953		3152
…		…
3064	{	3263	{
3065	api_ready (aTHX_ cb);	3264	api_ready (aTHX_ cb);
3066	sv_setiv (cb, 0); /* signal waiter */	3265	sv_setiv (cb, 0); /* signal waiter */
3067	}	3266	}
3068		3267
3069	SvREFCNT_dec (cb);	3268	SvREFCNT_dec_NN (cb);
3070		3269
3071	--count;	3270	--count;
3072	}	3271	}
3073	}	3272	}
3074		3273
…		…
3159	}	3358	}
3160		3359
3161	av_push (state, data_sv);	3360	av_push (state, data_sv);
3162		3361
3163	api_ready (aTHX_ coro);	3362	api_ready (aTHX_ coro);
3164	SvREFCNT_dec (coro);	3363	SvREFCNT_dec_NN (coro);
3165	SvREFCNT_dec ((AV *)state);	3364	SvREFCNT_dec_NN ((AV *)state);
3166	}	3365	}
3167		3366
3168	static int	3367	static int
3169	slf_check_aio_req (pTHX_ struct CoroSLF *frame)	3368	slf_check_aio_req (pTHX_ struct CoroSLF *frame)
3170	{	3369	{
…		…
3188	errno = data->errorno;	3387	errno = data->errorno;
3189	PL_laststype = data->laststype;	3388	PL_laststype = data->laststype;
3190	PL_laststatval = data->laststatval;	3389	PL_laststatval = data->laststatval;
3191	PL_statcache = data->statcache;	3390	PL_statcache = data->statcache;
3192		3391
3193	SvREFCNT_dec (data_sv);	3392	SvREFCNT_dec_NN (data_sv);
3194	}	3393	}
3195		3394
3196	/* push result values */	3395	/* push result values */
3197	{	3396	{
3198	dSP;	3397	dSP;
…		…
3413		3612
3414	PROTOTYPES: DISABLE	3613	PROTOTYPES: DISABLE
3415		3614
3416	BOOT:	3615	BOOT:
3417	{	3616	{
		3617	#define VARx(name,expr,type) if (sizeof (type) < sizeof (expr)) croak ("FATAL: Coro thread context slot '" # name "' too small for this version of perl.");
		3618	#include "state.h"
3418	#ifdef USE_ITHREADS	3619	#ifdef USE_ITHREADS
3419	# if CORO_PTHREAD	3620	# if CORO_PTHREAD
3420	coro_thx = PERL_GET_CONTEXT;	3621	coro_thx = PERL_GET_CONTEXT;
3421	# endif	3622	# endif
3422	#endif	3623	#endif
…		…
3434		3635
3435	orig_sigelem_get = PL_vtbl_sigelem.svt_get; PL_vtbl_sigelem.svt_get = coro_sigelem_get;	3636	orig_sigelem_get = PL_vtbl_sigelem.svt_get; PL_vtbl_sigelem.svt_get = coro_sigelem_get;
3436	orig_sigelem_set = PL_vtbl_sigelem.svt_set; PL_vtbl_sigelem.svt_set = coro_sigelem_set;	3637	orig_sigelem_set = PL_vtbl_sigelem.svt_set; PL_vtbl_sigelem.svt_set = coro_sigelem_set;
3437	orig_sigelem_clr = PL_vtbl_sigelem.svt_clear; PL_vtbl_sigelem.svt_clear = coro_sigelem_clr;	3638	orig_sigelem_clr = PL_vtbl_sigelem.svt_clear; PL_vtbl_sigelem.svt_clear = coro_sigelem_clr;
3438		3639
3439	hv_sig = coro_get_hv (aTHX_ "SIG", TRUE);
3440	rv_diehook = newRV_inc ((SV *)gv_fetchpv ("Coro::State::diehook" , 0, SVt_PVCV));	3640	rv_diehook = newRV_inc ((SV *)gv_fetchpv ("Coro::State::diehook" , 0, SVt_PVCV));
3441	rv_warnhook = newRV_inc ((SV *)gv_fetchpv ("Coro::State::warnhook", 0, SVt_PVCV));	3641	rv_warnhook = newRV_inc ((SV *)gv_fetchpv ("Coro::State::warnhook", 0, SVt_PVCV));
3442		3642
3443	coro_state_stash = gv_stashpv ("Coro::State", TRUE);	3643	coro_state_stash = gv_stashpv ("Coro::State", TRUE);
3444		3644
…		…
3750	if (ecb_expect_false (current == self))	3950	if (ecb_expect_false (current == self))
3751	coro_times_sub (SvSTATE (coro_current));	3951	coro_times_sub (SvSTATE (coro_current));
3752	}	3952	}
3753		3953
3754	void	3954	void
3755	swap_sv (Coro::State coro, SV sv, SV swapsv)	3955	swap_sv (Coro::State coro, SV sva, SV svb)
3756	CODE:	3956	CODE:
3757	{	3957	{
3758	struct coro *current = SvSTATE_current;	3958	struct coro *current = SvSTATE_current;
		3959	AV *swap_sv;
		3960	int i;
		3961
		3962	sva = SvRV (sva);
		3963	svb = SvRV (svb);
3759		3964
3760	if (current == coro)	3965	if (current == coro)
3761	SWAP_SVS (current);	3966	SWAP_SVS_LEAVE (current);
3762		3967
3763	if (!coro->swap_sv)	3968	if (!coro->swap_sv)
3764	coro->swap_sv = newAV ();	3969	coro->swap_sv = newAV ();
3765		3970
		3971	swap_sv = coro->swap_sv;
		3972
		3973	for (i = AvFILLp (swap_sv) - 1; i >= 0; i -= 2)
		3974	{
		3975	SV *a = AvARRAY (swap_sv)[i ];
		3976	SV *b = AvARRAY (swap_sv)[i + 1];
		3977
		3978	if (a == sva && b == svb)
		3979	{
		3980	SvREFCNT_dec_NN (a);
		3981	SvREFCNT_dec_NN (b);
		3982
		3983	for (; i <= AvFILLp (swap_sv) - 2; i++)
		3984	AvARRAY (swap_sv)[i] = AvARRAY (swap_sv)[i + 2];
		3985
		3986	AvFILLp (swap_sv) -= 2;
		3987
		3988	goto removed;
		3989	}
		3990	}
		3991
3766	av_push (coro->swap_sv, SvREFCNT_inc_NN (SvRV (sv )));	3992	av_push (swap_sv, SvREFCNT_inc_NN (sva));
3767	av_push (coro->swap_sv, SvREFCNT_inc_NN (SvRV (swapsv)));	3993	av_push (swap_sv, SvREFCNT_inc_NN (svb));
		3994
		3995	removed:
3768		3996
3769	if (current == coro)	3997	if (current == coro)
3770	SWAP_SVS (current);	3998	SWAP_SVS_ENTER (current);
3771	}	3999	}
3772		4000
3773		4001
3774	MODULE = Coro::State PACKAGE = Coro	4002	MODULE = Coro::State PACKAGE = Coro
3775		4003
3776	BOOT:	4004	BOOT:
3777	{	4005	{
		4006	if (SVt_LAST > 32)
		4007	croak ("Coro internal error: SVt_LAST > 32, swap_sv might need adjustment");
		4008
3778	sv_pool_rss = coro_get_sv (aTHX_ "Coro::POOL_RSS" , TRUE);	4009	sv_pool_rss = coro_get_sv (aTHX_ "Coro::POOL_RSS" , TRUE);
3779	sv_pool_size = coro_get_sv (aTHX_ "Coro::POOL_SIZE" , TRUE);	4010	sv_pool_size = coro_get_sv (aTHX_ "Coro::POOL_SIZE" , TRUE);
3780	cv_coro_run = get_cv ( "Coro::_coro_run" , GV_ADD);	4011	cv_coro_run = get_cv ( "Coro::_coro_run" , GV_ADD);
3781	coro_current = coro_get_sv (aTHX_ "Coro::current" , FALSE); SvREADONLY_on (coro_current);	4012	coro_current = coro_get_sv (aTHX_ "Coro::current" , FALSE); SvREADONLY_on (coro_current);
3782	av_async_pool = coro_get_av (aTHX_ "Coro::async_pool", TRUE);	4013	av_async_pool = coro_get_av (aTHX_ "Coro::async_pool", TRUE);
…		…
3808	coroapi.ready = api_ready;	4039	coroapi.ready = api_ready;
3809	coroapi.is_ready = api_is_ready;	4040	coroapi.is_ready = api_is_ready;
3810	coroapi.nready = coro_nready;	4041	coroapi.nready = coro_nready;
3811	coroapi.current = coro_current;	4042	coroapi.current = coro_current;
3812		4043
		4044	coroapi.enterleave_hook = api_enterleave_hook;
		4045	coroapi.enterleave_unhook = api_enterleave_unhook;
		4046	coroapi.enterleave_scope_hook = api_enterleave_scope_hook;
		4047
3813	/GCoroAPI = &coroapi;/	4048	/GCoroAPI = &coroapi;/
3814	sv_setiv (sv, (IV)&coroapi);	4049	sv_setiv (sv, (IV)&coroapi);
3815	SvREADONLY_on (sv);	4050	SvREADONLY_on (sv);
3816	}	4051	}
3817	}	4052	}
…		…
3882		4117
3883	void	4118	void
3884	_set_current (SV *current)	4119	_set_current (SV *current)
3885	PROTOTYPE: $	4120	PROTOTYPE: $
3886	CODE:	4121	CODE:
3887	SvREFCNT_dec (SvRV (coro_current));	4122	SvREFCNT_dec_NN (SvRV (coro_current));
3888	SvRV_set (coro_current, SvREFCNT_inc_NN (SvRV (current)));	4123	SvRV_set (coro_current, SvREFCNT_inc_NN (SvRV (current)));
3889		4124
3890	void	4125	void
3891	_set_readyhook (SV *hook)	4126	_set_readyhook (SV *hook)
3892	PROTOTYPE: $	4127	PROTOTYPE: $
…		…
3976		4211
3977	if ((SV *)hv == &PL_sv_undef)	4212	if ((SV *)hv == &PL_sv_undef)
3978	{	4213	{
3979	SV sv = coro_new (aTHX_ coro_stash, (SV *)&cv_pool_handler, 1, 1);	4214	SV sv = coro_new (aTHX_ coro_stash, (SV *)&cv_pool_handler, 1, 1);
3980	hv = (HV *)SvREFCNT_inc_NN (SvRV (sv));	4215	hv = (HV *)SvREFCNT_inc_NN (SvRV (sv));
3981	SvREFCNT_dec (sv);	4216	SvREFCNT_dec_NN (sv);
3982	}	4217	}
3983		4218
3984	{	4219	{
3985	struct coro *coro = SvSTATE_hv (hv);	4220	struct coro *coro = SvSTATE_hv (hv);
3986		4221
…		…
3993	api_ready (aTHX_ (SV *)hv);	4228	api_ready (aTHX_ (SV *)hv);
3994		4229
3995	if (GIMME_V != G_VOID)	4230	if (GIMME_V != G_VOID)
3996	XPUSHs (sv_2mortal (newRV_noinc ((SV *)hv)));	4231	XPUSHs (sv_2mortal (newRV_noinc ((SV *)hv)));
3997	else	4232	else
3998	SvREFCNT_dec (hv);	4233	SvREFCNT_dec_NN (hv);
3999	}	4234	}
4000		4235
4001	SV *	4236	SV *
4002	rouse_cb ()	4237	rouse_cb ()
4003	PROTOTYPE:	4238	PROTOTYPE:
…		…
4082	RETVAL = newSVsv (AvARRAY ((AV *)SvRV (self))[0]);	4317	RETVAL = newSVsv (AvARRAY ((AV *)SvRV (self))[0]);
4083	OUTPUT:	4318	OUTPUT:
4084	RETVAL	4319	RETVAL
4085		4320
4086	void	4321	void
4087	up (SV *self, int adjust = 1)	4322	up (SV *self)
4088	ALIAS:
4089	adjust = 1
4090	CODE:	4323	CODE:
		4324	coro_semaphore_adjust (aTHX_ (AV *)SvRV (self), 1);
		4325
		4326	void
		4327	adjust (SV *self, int adjust)
		4328	CODE:
4091	coro_semaphore_adjust (aTHX_ (AV *)SvRV (self), ix ? adjust : 1);	4329	coro_semaphore_adjust (aTHX_ (AV *)SvRV (self), adjust);
4092		4330
4093	void	4331	void
4094	down (...)	4332	down (...)
4095	CODE:	4333	CODE:
4096	CORO_EXECUTE_SLF_XS (slf_init_semaphore_down);	4334	CORO_EXECUTE_SLF_XS (slf_init_semaphore_down);

Diff Legend

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

Comparing Coro/Coro/State.xs (file contents): Revision 1.437 by root, Tue Nov 5 15:13:42 2013 UTC vs. Revision 1.463 by root, Wed Jun 22 20:37:27 2016 UTC

Diff Legend

Comparing Coro/Coro/State.xs (file contents):
Revision 1.437 by root, Tue Nov 5 15:13:42 2013 UTC vs.
Revision 1.463 by root, Wed Jun 22 20:37:27 2016 UTC