ViewVC Help

View File | Revision Log | Show Annotations | Download File

/cvs/Coro/Coro/State.xs

Comparing Coro/Coro/State.xs (file contents):
Revision 1.391 by root, Thu Mar 31 04:24:19 2011 UTC vs.
Revision 1.404 by root, Fri Jun 10 12:27:02 2011 UTC

…		…
12	#include "perl.h"	12	#include "perl.h"
13	#include "XSUB.h"	13	#include "XSUB.h"
14	#include "perliol.h"	14	#include "perliol.h"
15		15
16	#include "schmorp.h"	16	#include "schmorp.h"
		17	#include "ecb.h"
17		18
		19	#include <stddef.h>
18	#include <stdio.h>	20	#include <stdio.h>
19	#include <errno.h>	21	#include <errno.h>
20	#include <assert.h>	22	#include <assert.h>
21		23
22	#ifndef SVs_PADSTALE	24	#ifndef SVs_PADSTALE
…		…
86	# define STACKLEVEL ((void *)&stacklevel)	88	# define STACKLEVEL ((void *)&stacklevel)
87	#endif	89	#endif
88		90
89	#define IN_DESTRUCT PL_dirty	91	#define IN_DESTRUCT PL_dirty
90		92
91	#if __GNUC__ >= 3
92	# define attribute(x) __attribute__(x)
93	# define expect(expr,value) __builtin_expect ((expr), (value))
94	# define INLINE static inline
95	#else
96	# define attribute(x)
97	# define expect(expr,value) (expr)
98	# define INLINE static
99	#endif
100
101	#define expect_false(expr) expect ((expr) != 0, 0)
102	#define expect_true(expr) expect ((expr) != 0, 1)
103
104	#define NOINLINE attribute ((noinline))
105
106	#include "CoroAPI.h"	93	#include "CoroAPI.h"
107	#define GCoroAPI (&coroapi) /* very sneaky */	94	#define GCoroAPI (&coroapi) /* very sneaky */
108		95
109	#ifdef USE_ITHREADS	96	#ifdef USE_ITHREADS
110	# if CORO_PTHREAD	97	# if CORO_PTHREAD
…		…
126	static void (*u2time)(pTHX_ UV ret[2]);	113	static void (*u2time)(pTHX_ UV ret[2]);
127		114
128	/* we hijack an hopefully unused CV flag for our purposes */	115	/* we hijack an hopefully unused CV flag for our purposes */
129	#define CVf_SLF 0x4000	116	#define CVf_SLF 0x4000
130	static OP *pp_slf (pTHX);	117	static OP *pp_slf (pTHX);
		118	static void slf_destroy (pTHX_ struct coro *coro);
131		119
132	static U32 cctx_gen;	120	static U32 cctx_gen;
133	static size_t cctx_stacksize = CORO_STACKSIZE;	121	static size_t cctx_stacksize = CORO_STACKSIZE;
134	static struct CoroAPI coroapi;	122	static struct CoroAPI coroapi;
135	static AV *main_mainstack; /* used to differentiate between $main and others */	123	static AV *main_mainstack; /* used to differentiate between $main and others */
…		…
165	static char times_valid;	153	static char times_valid;
166		154
167	static struct coro_cctx *cctx_first;	155	static struct coro_cctx *cctx_first;
168	static int cctx_count, cctx_idle;	156	static int cctx_count, cctx_idle;
169		157
170	enum {	158	enum
		159	{
171	CC_MAPPED = 0x01,	160	CC_MAPPED = 0x01,
172	CC_NOREUSE = 0x02, /* throw this away after tracing */	161	CC_NOREUSE = 0x02, /* throw this away after tracing */
173	CC_TRACE = 0x04,	162	CC_TRACE = 0x04,
174	CC_TRACE_SUB = 0x08, /* trace sub calls */	163	CC_TRACE_SUB = 0x08, /* trace sub calls */
175	CC_TRACE_LINE = 0x10, /* trace each statement */	164	CC_TRACE_LINE = 0x10, /* trace each statement */
…		…
196	int valgrind_id;	185	int valgrind_id;
197	#endif	186	#endif
198	unsigned char flags;	187	unsigned char flags;
199	} coro_cctx;	188	} coro_cctx;
200		189
201	coro_cctx *cctx_current; /* the currently running cctx */	190	static coro_cctx *cctx_current; /* the currently running cctx */
202		191
203	/*****************************************************************************/	192	/*****************************************************************************/
204		193
		194	static MGVTBL coro_state_vtbl;
		195
205	enum {	196	enum
		197	{
206	CF_RUNNING = 0x0001, /* coroutine is running */	198	CF_RUNNING = 0x0001, /* coroutine is running */
207	CF_READY = 0x0002, /* coroutine is ready */	199	CF_READY = 0x0002, /* coroutine is ready */
208	CF_NEW = 0x0004, /* has never been switched to */	200	CF_NEW = 0x0004, /* has never been switched to */
209	CF_DESTROYED = 0x0008, /* coroutine data has been freed */	201	CF_ZOMBIE = 0x0008, /* coroutine data has been freed */
210	CF_SUSPENDED = 0x0010, /* coroutine can't be scheduled */	202	CF_SUSPENDED = 0x0010, /* coroutine can't be scheduled */
		203	CF_NOCANCEL = 0x0020, /* cannot cancel, set slf_frame.data to 1 (hackish) */
211	};	204	};
212		205
213	/* the structure where most of the perl state is stored, overlaid on the cxstack */	206	/* the structure where most of the perl state is stored, overlaid on the cxstack */
214	typedef struct	207	typedef struct
215	{	208	{
…		…
221	#define VAR(name,type) type name;	214	#define VAR(name,type) type name;
222	# include "state.h"	215	# include "state.h"
223	#undef VAR	216	#undef VAR
224	} perl_slots;	217	} perl_slots;
225		218
		219	// how many context stack entries do we need for perl_slots
226	#define SLOT_COUNT ((sizeof (perl_slots) + sizeof (PERL_CONTEXT) - 1) / sizeof (PERL_CONTEXT))	220	#define SLOT_COUNT ((sizeof (perl_slots) + sizeof (PERL_CONTEXT) - 1) / sizeof (PERL_CONTEXT))
227		221
228	/* this is a structure representing a perl-level coroutine */	222	/* this is a structure representing a perl-level coroutine */
229	struct coro {	223	struct coro
		224	{
230	/* the C coroutine allocated to this perl coroutine, if any */	225	/* the C coroutine allocated to this perl coroutine, if any */
231	coro_cctx *cctx;	226	coro_cctx *cctx;
232		227
233	/* ready queue */	228	/* ready queue */
234	struct coro *next_ready;	229	struct coro *next_ready;
…		…
236	/* state data */	231	/* state data */
237	struct CoroSLF slf_frame; /* saved slf frame */	232	struct CoroSLF slf_frame; /* saved slf frame */
238	AV *mainstack;	233	AV *mainstack;
239	perl_slots *slot; /* basically the saved sp */	234	perl_slots *slot; /* basically the saved sp */
240		235
241	CV *startcv; /* the CV to execute */	236	CV *startcv; /* the CV to execute */
242	AV *args; /* data associated with this coroutine (initial args) */	237	AV *args; /* data associated with this coroutine (initial args) */
243	int refcnt; /* coroutines are refcounted, yes */
244	int flags; /* CF_ flags */	238	int flags; /* CF_ flags */
245	HV *hv; /* the perl hash associated with this coro, if any */	239	HV *hv; /* the perl hash associated with this coro, if any */
246	void (*on_destroy)(pTHX_ struct coro *coro); /* for temporary use by xs in critical sections */
247		240
248	/* statistics */	241	/* statistics */
249	int usecount; /* number of transfers to this coro */	242	int usecount; /* number of transfers to this coro */
250		243
251	/* coro process data */	244	/* coro process data */
252	int prio;	245	int prio;
253	SV *except; /* exception to be thrown */	246	SV *except; /* exception to be thrown */
254	SV *rouse_cb;	247	SV *rouse_cb; /* last rouse callback */
		248	AV *on_destroy; /* callbacks or coros to notify on destroy */
		249	AV *status; /* the exit status list */
255		250
256	/* async_pool */	251	/* async_pool */
257	SV *saved_deffh;	252	SV *saved_deffh;
258	SV *invoke_cb;	253	SV *invoke_cb;
259	AV *invoke_av;	254	AV *invoke_av;
…		…
275	typedef struct coro *Coro__State;	270	typedef struct coro *Coro__State;
276	typedef struct coro *Coro__State_or_hashref;	271	typedef struct coro *Coro__State_or_hashref;
277		272
278	/* the following variables are effectively part of the perl context */	273	/* the following variables are effectively part of the perl context */
279	/* and get copied between struct coro and these variables */	274	/* and get copied between struct coro and these variables */
280	/* the mainr easonw e don't support windows process emulation */	275	/* the main reason we don't support windows process emulation */
281	static struct CoroSLF slf_frame; /* the current slf frame */	276	static struct CoroSLF slf_frame; /* the current slf frame */
282		277
283	/** Coro ********************************************************************/	278	/** Coro ********************************************************************/
284		279
285	#define CORO_PRIO_MAX 3	280	#define CORO_PRIO_MAX 3
…		…
291		286
292	/* for Coro.pm */	287	/* for Coro.pm */
293	static SV *coro_current;	288	static SV *coro_current;
294	static SV *coro_readyhook;	289	static SV *coro_readyhook;
295	static struct coro *coro_ready [CORO_PRIO_MAX - CORO_PRIO_MIN + 1][2]; /* head|tail */	290	static struct coro *coro_ready [CORO_PRIO_MAX - CORO_PRIO_MIN + 1][2]; /* head|tail */
296	static CV *cv_coro_run, *cv_coro_terminate;	291	static CV *cv_coro_run;
297	static struct coro *coro_first;	292	static struct coro *coro_first;
298	#define coro_nready coroapi.nready	293	#define coro_nready coroapi.nready
299		294
300	/** Coro::Select ************************************************************/	295	/** Coro::Select ************************************************************/
301		296
…		…
319		314
320	/** time stuff **************************************************************/	315	/** time stuff **************************************************************/
321		316
322	#ifdef HAS_GETTIMEOFDAY	317	#ifdef HAS_GETTIMEOFDAY
323		318
324	static void	319	ECB_INLINE void
325	coro_u2time (pTHX_ UV ret[2])	320	coro_u2time (pTHX_ UV ret[2])
326	{	321	{
327	struct timeval tv;	322	struct timeval tv;
328	gettimeofday (&tv, 0);	323	gettimeofday (&tv, 0);
329		324
330	ret [0] = tv.tv_sec;	325	ret [0] = tv.tv_sec;
331	ret [1] = tv.tv_usec;	326	ret [1] = tv.tv_usec;
332	}	327	}
333		328
334	static double	329	ECB_INLINE double
335	coro_nvtime ()	330	coro_nvtime ()
336	{	331	{
337	struct timeval tv;	332	struct timeval tv;
338	gettimeofday (&tv, 0);	333	gettimeofday (&tv, 0);
339		334
340	return tv.tv_sec + tv.tv_usec * 1e-6;	335	return tv.tv_sec + tv.tv_usec * 1e-6;
341	}	336	}
342		337
343	static void	338	ECB_INLINE void
344	time_init (pTHX)	339	time_init (pTHX)
345	{	340	{
346	nvtime = coro_nvtime;	341	nvtime = coro_nvtime;
347	u2time = coro_u2time;	342	u2time = coro_u2time;
348	}	343	}
349		344
350	#else	345	#else
351		346
352	static void	347	ECB_INLINE void
353	time_init (pTHX)	348	time_init (pTHX)
354	{	349	{
355	SV **svp;	350	SV **svp;
356		351
357	require_pv ("Time/HiRes.pm");	352	require_pv ("Time/HiRes.pm");
358		353
359	svp = hv_fetch (PL_modglobal, "Time::NVtime", 12, 0);	354	svp = hv_fetch (PL_modglobal, "Time::NVtime", 12, 0);
360		355
361	if (!svp) croak ("Time::HiRes is required, but missing.");	356	if (!svp) croak ("Time::HiRes is required, but missing. Caught");
362	if (!SvIOK (*svp)) croak ("Time::NVtime isn't a function pointer");	357	if (!SvIOK (*svp)) croak ("Time::NVtime isn't a function pointer. Caught");
363		358
364	nvtime = INT2PTR (double (*)(), SvIV (*svp));	359	nvtime = INT2PTR (double (*)(), SvIV (*svp));
365		360
366	svp = hv_fetch (PL_modglobal, "Time::U2time", 12, 0);	361	svp = hv_fetch (PL_modglobal, "Time::U2time", 12, 0);
367	u2time = INT2PTR (void (*)(pTHX_ UV ret[2]), SvIV (*svp));	362	u2time = INT2PTR (void (*)(pTHX_ UV ret[2]), SvIV (*svp));
…		…
369		364
370	#endif	365	#endif
371		366
372	/** lowlevel stuff **********************************************************/	367	/** lowlevel stuff **********************************************************/
373		368
374	static SV *	369	static SV * ecb_noinline
375	coro_get_sv (pTHX_ const char *name, int create)	370	coro_get_sv (pTHX_ const char *name, int create)
376	{	371	{
377	#if PERL_VERSION_ATLEAST (5,10,0)	372	#if PERL_VERSION_ATLEAST (5,10,0)
378	/* silence stupid and wrong 5.10 warning that I am unable to switch off */	373	/* silence stupid and wrong 5.10 warning that I am unable to switch off */
379	get_sv (name, create);	374	get_sv (name, create);
380	#endif	375	#endif
381	return get_sv (name, create);	376	return get_sv (name, create);
382	}	377	}
383		378
384	static AV *	379	static AV * ecb_noinline
385	coro_get_av (pTHX_ const char *name, int create)	380	coro_get_av (pTHX_ const char *name, int create)
386	{	381	{
387	#if PERL_VERSION_ATLEAST (5,10,0)	382	#if PERL_VERSION_ATLEAST (5,10,0)
388	/* silence stupid and wrong 5.10 warning that I am unable to switch off */	383	/* silence stupid and wrong 5.10 warning that I am unable to switch off */
389	get_av (name, create);	384	get_av (name, create);
390	#endif	385	#endif
391	return get_av (name, create);	386	return get_av (name, create);
392	}	387	}
393		388
394	static HV *	389	static HV * ecb_noinline
395	coro_get_hv (pTHX_ const char *name, int create)	390	coro_get_hv (pTHX_ const char *name, int create)
396	{	391	{
397	#if PERL_VERSION_ATLEAST (5,10,0)	392	#if PERL_VERSION_ATLEAST (5,10,0)
398	/* silence stupid and wrong 5.10 warning that I am unable to switch off */	393	/* silence stupid and wrong 5.10 warning that I am unable to switch off */
399	get_hv (name, create);	394	get_hv (name, create);
400	#endif	395	#endif
401	return get_hv (name, create);	396	return get_hv (name, create);
402	}	397	}
403		398
404	INLINE void	399	ECB_INLINE void
405	coro_times_update ()	400	coro_times_update ()
406	{	401	{
407	#ifdef coro_clock_gettime	402	#ifdef coro_clock_gettime
408	struct timespec ts;	403	struct timespec ts;
409		404
…		…
422	time_real [0] = tv [0];	417	time_real [0] = tv [0];
423	time_real [1] = tv [1] * 1000;	418	time_real [1] = tv [1] * 1000;
424	#endif	419	#endif
425	}	420	}
426		421
427	INLINE void	422	ECB_INLINE void
428	coro_times_add (struct coro *c)	423	coro_times_add (struct coro *c)
429	{	424	{
430	c->t_real [1] += time_real [1];	425	c->t_real [1] += time_real [1];
431	if (c->t_real [1] > 1000000000) { c->t_real [1] -= 1000000000; ++c->t_real [0]; }	426	if (c->t_real [1] > 1000000000) { c->t_real [1] -= 1000000000; ++c->t_real [0]; }
432	c->t_real [0] += time_real [0];	427	c->t_real [0] += time_real [0];
…		…
434	c->t_cpu [1] += time_cpu [1];	429	c->t_cpu [1] += time_cpu [1];
435	if (c->t_cpu [1] > 1000000000) { c->t_cpu [1] -= 1000000000; ++c->t_cpu [0]; }	430	if (c->t_cpu [1] > 1000000000) { c->t_cpu [1] -= 1000000000; ++c->t_cpu [0]; }
436	c->t_cpu [0] += time_cpu [0];	431	c->t_cpu [0] += time_cpu [0];
437	}	432	}
438		433
439	INLINE void	434	ECB_INLINE void
440	coro_times_sub (struct coro *c)	435	coro_times_sub (struct coro *c)
441	{	436	{
442	if (c->t_real [1] < time_real [1]) { c->t_real [1] += 1000000000; --c->t_real [0]; }	437	if (c->t_real [1] < time_real [1]) { c->t_real [1] += 1000000000; --c->t_real [0]; }
443	c->t_real [1] -= time_real [1];	438	c->t_real [1] -= time_real [1];
444	c->t_real [0] -= time_real [0];	439	c->t_real [0] -= time_real [0];
…		…
452	/* magic glue */	447	/* magic glue */
453		448
454	#define CORO_MAGIC_type_cv 26	449	#define CORO_MAGIC_type_cv 26
455	#define CORO_MAGIC_type_state PERL_MAGIC_ext	450	#define CORO_MAGIC_type_state PERL_MAGIC_ext
456		451
457	#define CORO_MAGIC_NN(sv, type) \	452	#define CORO_MAGIC_NN(sv, type) \
458	(expect_true (SvMAGIC (sv)->mg_type == type) \	453	(ecb_expect_true (SvMAGIC (sv)->mg_type == type) \
459	? SvMAGIC (sv) \	454	? SvMAGIC (sv) \
460	: mg_find (sv, type))	455	: mg_find (sv, type))
461		456
462	#define CORO_MAGIC(sv, type) \	457	#define CORO_MAGIC(sv, type) \
463	(expect_true (SvMAGIC (sv)) \	458	(ecb_expect_true (SvMAGIC (sv)) \
464	? CORO_MAGIC_NN (sv, type) \	459	? CORO_MAGIC_NN (sv, type) \
465	: 0)	460	: 0)
466		461
467	#define CORO_MAGIC_cv(cv) CORO_MAGIC (((SV *)(cv)), CORO_MAGIC_type_cv)	462	#define CORO_MAGIC_cv(cv) CORO_MAGIC (((SV *)(cv)), CORO_MAGIC_type_cv)
468	#define CORO_MAGIC_state(sv) CORO_MAGIC_NN (((SV *)(sv)), CORO_MAGIC_type_state)	463	#define CORO_MAGIC_state(sv) CORO_MAGIC_NN (((SV *)(sv)), CORO_MAGIC_type_state)
469		464
		465	ECB_INLINE MAGIC *
		466	SvSTATEhv_p (pTHX_ SV *coro)
		467	{
		468	MAGIC *mg;
		469
		470	if (ecb_expect_true (
		471	SvTYPE (coro) == SVt_PVHV
		472	&& (mg = CORO_MAGIC_state (coro))
		473	&& mg->mg_virtual == &coro_state_vtbl
		474	))
		475	return mg;
		476
		477	return 0;
		478	}
		479
470	INLINE struct coro *	480	ECB_INLINE struct coro *
471	SvSTATE_ (pTHX_ SV *coro)	481	SvSTATE_ (pTHX_ SV *coro)
472	{	482	{
473	HV *stash;
474	MAGIC *mg;	483	MAGIC *mg;
475		484
476	if (SvROK (coro))	485	if (SvROK (coro))
477	coro = SvRV (coro);	486	coro = SvRV (coro);
478		487
479	if (expect_false (SvTYPE (coro) != SVt_PVHV))	488	mg = SvSTATEhv_p (aTHX_ coro);
		489	if (!mg)
480	croak ("Coro::State object required");	490	croak ("Coro::State object required");
481		491
482	stash = SvSTASH (coro);
483	if (expect_false (stash != coro_stash && stash != coro_state_stash))
484	{
485	/* very slow, but rare, check */
486	if (!sv_derived_from (sv_2mortal (newRV_inc (coro)), "Coro::State"))
487	croak ("Coro::State object required");
488	}
489
490	mg = CORO_MAGIC_state (coro);
491	return (struct coro *)mg->mg_ptr;	492	return (struct coro *)mg->mg_ptr;
492	}	493	}
493		494
494	#define SvSTATE(sv) SvSTATE_ (aTHX_ (sv))	495	#define SvSTATE(sv) SvSTATE_ (aTHX_ (sv))
495		496
…		…
498	#define SvSTATE_current SvSTATE_hv (SvRV (coro_current))	499	#define SvSTATE_current SvSTATE_hv (SvRV (coro_current))
499		500
500	/*****************************************************************************/	501	/*****************************************************************************/
501	/* padlist management and caching */	502	/* padlist management and caching */
502		503
503	static AV *	504	ECB_INLINE AV *
504	coro_derive_padlist (pTHX_ CV *cv)	505	coro_derive_padlist (pTHX_ CV *cv)
505	{	506	{
506	AV *padlist = CvPADLIST (cv);	507	AV *padlist = CvPADLIST (cv);
507	AV *newpadlist, *newpad;	508	AV *newpadlist, *newpad;
508		509
…		…
520	av_store (newpadlist, 1, (SV *)newpad);	521	av_store (newpadlist, 1, (SV *)newpad);
521		522
522	return newpadlist;	523	return newpadlist;
523	}	524	}
524		525
525	static void	526	ECB_INLINE void
526	free_padlist (pTHX_ AV *padlist)	527	free_padlist (pTHX_ AV *padlist)
527	{	528	{
528	/* may be during global destruction */	529	/* may be during global destruction */
529	if (!IN_DESTRUCT)	530	if (!IN_DESTRUCT)
530	{	531	{
…		…
573	0, 0, 0, 0,	574	0, 0, 0, 0,
574	coro_cv_free	575	coro_cv_free
575	};	576	};
576		577
577	/* the next two functions merely cache the padlists */	578	/* the next two functions merely cache the padlists */
578	static void	579	ECB_INLINE void
579	get_padlist (pTHX_ CV *cv)	580	get_padlist (pTHX_ CV *cv)
580	{	581	{
581	MAGIC *mg = CORO_MAGIC_cv (cv);	582	MAGIC *mg = CORO_MAGIC_cv (cv);
582	AV *av;	583	AV *av;
583		584
584	if (expect_true (mg && AvFILLp ((av = (AV *)mg->mg_obj)) >= 0))	585	if (ecb_expect_true (mg && AvFILLp ((av = (AV *)mg->mg_obj)) >= 0))
585	CvPADLIST (cv) = (AV *)AvARRAY (av)[AvFILLp (av)--];	586	CvPADLIST (cv) = (AV *)AvARRAY (av)[AvFILLp (av)--];
586	else	587	else
587	{	588	{
588	#if CORO_PREFER_PERL_FUNCTIONS	589	#if CORO_PREFER_PERL_FUNCTIONS
589	/* this is probably cleaner? but also slower! */	590	/* this is probably cleaner? but also slower! */
…		…
596	CvPADLIST (cv) = coro_derive_padlist (aTHX_ cv);	597	CvPADLIST (cv) = coro_derive_padlist (aTHX_ cv);
597	#endif	598	#endif
598	}	599	}
599	}	600	}
600		601
601	static void	602	ECB_INLINE void
602	put_padlist (pTHX_ CV *cv)	603	put_padlist (pTHX_ CV *cv)
603	{	604	{
604	MAGIC *mg = CORO_MAGIC_cv (cv);	605	MAGIC *mg = CORO_MAGIC_cv (cv);
605	AV *av;	606	AV *av;
606		607
607	if (expect_false (!mg))	608	if (ecb_expect_false (!mg))
608	mg = sv_magicext ((SV *)cv, (SV *)newAV (), CORO_MAGIC_type_cv, &coro_cv_vtbl, 0, 0);	609	mg = sv_magicext ((SV *)cv, (SV *)newAV (), CORO_MAGIC_type_cv, &coro_cv_vtbl, 0, 0);
609		610
610	av = (AV *)mg->mg_obj;	611	av = (AV *)mg->mg_obj;
611		612
612	if (expect_false (AvFILLp (av) >= AvMAX (av)))	613	if (ecb_expect_false (AvFILLp (av) >= AvMAX (av)))
613	av_extend (av, AvFILLp (av) + 1);	614	av_extend (av, AvFILLp (av) + 1);
614		615
615	AvARRAY (av)[++AvFILLp (av)] = (SV *)CvPADLIST (cv);	616	AvARRAY (av)[++AvFILLp (av)] = (SV *)CvPADLIST (cv);
616	}	617	}
617		618
…		…
662	}	663	}
663	#endif	664	#endif
664	}	665	}
665	}	666	}
666		667
667	#define SWAP_SVS(coro) \	668	#define SWAP_SVS(coro) \
668	if (expect_false ((coro)->swap_sv)) \	669	if (ecb_expect_false ((coro)->swap_sv)) \
669	swap_svs (aTHX_ (coro))	670	swap_svs (aTHX_ (coro))
670		671
671	static void	672	static void
672	on_enterleave_call (pTHX_ SV *cb);	673	on_enterleave_call (pTHX_ SV *cb);
673		674
…		…
693	dSP;	694	dSP;
694		695
695	CV *cv;	696	CV *cv;
696		697
697	/* now do the ugly restore mess */	698	/* now do the ugly restore mess */
698	while (expect_true (cv = (CV *)POPs))	699	while (ecb_expect_true (cv = (CV *)POPs))
699	{	700	{
700	put_padlist (aTHX_ cv); /* mark this padlist as available */	701	put_padlist (aTHX_ cv); /* mark this padlist as available */
701	CvDEPTH (cv) = PTR2IV (POPs);	702	CvDEPTH (cv) = PTR2IV (POPs);
702	CvPADLIST (cv) = (AV *)POPs;	703	CvPADLIST (cv) = (AV *)POPs;
703	}	704	}
…		…
706	}	707	}
707		708
708	slf_frame = c->slf_frame;	709	slf_frame = c->slf_frame;
709	CORO_THROW = c->except;	710	CORO_THROW = c->except;
710		711
711	if (expect_false (enable_times))	712	if (ecb_expect_false (enable_times))
712	{	713	{
713	if (expect_false (!times_valid))	714	if (ecb_expect_false (!times_valid))
714	coro_times_update ();	715	coro_times_update ();
715		716
716	coro_times_sub (c);	717	coro_times_sub (c);
717	}	718	}
718		719
719	if (expect_false (c->on_enter))	720	if (ecb_expect_false (c->on_enter))
720	{	721	{
721	int i;	722	int i;
722		723
723	for (i = 0; i <= AvFILLp (c->on_enter); ++i)	724	for (i = 0; i <= AvFILLp (c->on_enter); ++i)
724	on_enterleave_call (aTHX_ AvARRAY (c->on_enter)[i]);	725	on_enterleave_call (aTHX_ AvARRAY (c->on_enter)[i]);
…		…
730	static void	731	static void
731	save_perl (pTHX_ Coro__State c)	732	save_perl (pTHX_ Coro__State c)
732	{	733	{
733	SWAP_SVS (c);	734	SWAP_SVS (c);
734		735
735	if (expect_false (c->on_leave))	736	if (ecb_expect_false (c->on_leave))
736	{	737	{
737	int i;	738	int i;
738		739
739	for (i = AvFILLp (c->on_leave); i >= 0; --i)	740	for (i = AvFILLp (c->on_leave); i >= 0; --i)
740	on_enterleave_call (aTHX_ AvARRAY (c->on_leave)[i]);	741	on_enterleave_call (aTHX_ AvARRAY (c->on_leave)[i]);
741	}	742	}
742		743
743	times_valid = 0;	744	times_valid = 0;
744		745
745	if (expect_false (enable_times))	746	if (ecb_expect_false (enable_times))
746	{	747	{
747	coro_times_update (); times_valid = 1;	748	coro_times_update (); times_valid = 1;
748	coro_times_add (c);	749	coro_times_add (c);
749	}	750	}
750		751
…		…
764		765
765	XPUSHs (Nullsv);	766	XPUSHs (Nullsv);
766	/* this loop was inspired by pp_caller */	767	/* this loop was inspired by pp_caller */
767	for (;;)	768	for (;;)
768	{	769	{
769	while (expect_true (cxix >= 0))	770	while (ecb_expect_true (cxix >= 0))
770	{	771	{
771	PERL_CONTEXT *cx = &ccstk[cxix--];	772	PERL_CONTEXT *cx = &ccstk[cxix--];
772		773
773	if (expect_true (CxTYPE (cx) == CXt_SUB) || expect_false (CxTYPE (cx) == CXt_FORMAT))	774	if (ecb_expect_true (CxTYPE (cx) == CXt_SUB) || ecb_expect_false (CxTYPE (cx) == CXt_FORMAT))
774	{	775	{
775	CV *cv = cx->blk_sub.cv;	776	CV *cv = cx->blk_sub.cv;
776		777
777	if (expect_true (CvDEPTH (cv)))	778	if (ecb_expect_true (CvDEPTH (cv)))
778	{	779	{
779	EXTEND (SP, 3);	780	EXTEND (SP, 3);
780	PUSHs ((SV *)CvPADLIST (cv));	781	PUSHs ((SV *)CvPADLIST (cv));
781	PUSHs (INT2PTR (SV *, (IV)CvDEPTH (cv)));	782	PUSHs (INT2PTR (SV *, (IV)CvDEPTH (cv)));
782	PUSHs ((SV *)cv);	783	PUSHs ((SV *)cv);
…		…
785	get_padlist (aTHX_ cv);	786	get_padlist (aTHX_ cv);
786	}	787	}
787	}	788	}
788	}	789	}
789		790
790	if (expect_true (top_si->si_type == PERLSI_MAIN))	791	if (ecb_expect_true (top_si->si_type == PERLSI_MAIN))
791	break;	792	break;
792		793
793	top_si = top_si->si_prev;	794	top_si = top_si->si_prev;
794	ccstk = top_si->si_cxstack;	795	ccstk = top_si->si_cxstack;
795	cxix = top_si->si_cxix;	796	cxix = top_si->si_cxix;
…		…
797		798
798	PUTBACK;	799	PUTBACK;
799	}	800	}
800		801
801	/* allocate some space on the context stack for our purposes */	802	/* allocate some space on the context stack for our purposes */
802	/* we manually unroll here, as usually 2 slots is enough */	803	if (ecb_expect_false (cxstack_ix + SLOT_COUNT >= cxstack_max))
803	if (SLOT_COUNT >= 1) CXINC;
804	if (SLOT_COUNT >= 2) CXINC;
805	if (SLOT_COUNT >= 3) CXINC;
806	{	804	{
807	unsigned int i;	805	unsigned int i;
		806
808	for (i = 3; i < SLOT_COUNT; ++i)	807	for (i = 0; i < SLOT_COUNT; ++i)
809	CXINC;	808	CXINC;
810	}	809
811	cxstack_ix -= SLOT_COUNT; /* undo allocation */	810	cxstack_ix -= SLOT_COUNT; /* undo allocation */
		811	}
812		812
813	c->mainstack = PL_mainstack;	813	c->mainstack = PL_mainstack;
814		814
815	{	815	{
816	perl_slots *slot = c->slot = (perl_slots *)(cxstack + cxstack_ix + 1);	816	perl_slots *slot = c->slot = (perl_slots *)(cxstack + cxstack_ix + 1);
…		…
837	# define coro_init_stacks(thx) init_stacks ()	837	# define coro_init_stacks(thx) init_stacks ()
838	#else	838	#else
839	static void	839	static void
840	coro_init_stacks (pTHX)	840	coro_init_stacks (pTHX)
841	{	841	{
842	PL_curstackinfo = new_stackinfo(32, 8);	842	PL_curstackinfo = new_stackinfo(32, 4 + SLOT_COUNT); /* 3 is minimum due to perl rounding down in scope.c:GROW() */
843	PL_curstackinfo->si_type = PERLSI_MAIN;	843	PL_curstackinfo->si_type = PERLSI_MAIN;
844	PL_curstack = PL_curstackinfo->si_stack;	844	PL_curstack = PL_curstackinfo->si_stack;
845	PL_mainstack = PL_curstack; /* remember in case we switch stacks */	845	PL_mainstack = PL_curstack; /* remember in case we switch stacks */
846		846
847	PL_stack_base = AvARRAY(PL_curstack);	847	PL_stack_base = AvARRAY(PL_curstack);
…		…
954	#endif	954	#endif
955		955
956	/*	956	/*
957	* This overrides the default magic get method of %SIG elements.	957	* This overrides the default magic get method of %SIG elements.
958	* The original one doesn't provide for reading back of PL_diehook/PL_warnhook	958	* The original one doesn't provide for reading back of PL_diehook/PL_warnhook
959	* and instead of trying to save and restore the hash elements, we just provide	959	* and instead of trying to save and restore the hash elements (extremely slow),
960	* readback here.	960	* we just provide our own readback here.
961	*/	961	*/
962	static int	962	static int ecb_cold
963	coro_sigelem_get (pTHX_ SV *sv, MAGIC *mg)	963	coro_sigelem_get (pTHX_ SV *sv, MAGIC *mg)
964	{	964	{
965	const char *s = MgPV_nolen_const (mg);	965	const char *s = MgPV_nolen_const (mg);
966		966
967	if (*s == '_')	967	if (*s == '_')
…		…
979	}	979	}
980		980
981	return orig_sigelem_get ? orig_sigelem_get (aTHX_ sv, mg) : 0;	981	return orig_sigelem_get ? orig_sigelem_get (aTHX_ sv, mg) : 0;
982	}	982	}
983		983
984	static int	984	static int ecb_cold
985	coro_sigelem_clr (pTHX_ SV *sv, MAGIC *mg)	985	coro_sigelem_clr (pTHX_ SV *sv, MAGIC *mg)
986	{	986	{
987	const char *s = MgPV_nolen_const (mg);	987	const char *s = MgPV_nolen_const (mg);
988		988
989	if (*s == '_')	989	if (*s == '_')
…		…
1003	}	1003	}
1004		1004
1005	return orig_sigelem_clr ? orig_sigelem_clr (aTHX_ sv, mg) : 0;	1005	return orig_sigelem_clr ? orig_sigelem_clr (aTHX_ sv, mg) : 0;
1006	}	1006	}
1007		1007
1008	static int	1008	static int ecb_cold
1009	coro_sigelem_set (pTHX_ SV *sv, MAGIC *mg)	1009	coro_sigelem_set (pTHX_ SV *sv, MAGIC *mg)
1010	{	1010	{
1011	const char *s = MgPV_nolen_const (mg);	1011	const char *s = MgPV_nolen_const (mg);
1012		1012
1013	if (*s == '_')	1013	if (*s == '_')
…		…
1048	return 1;	1048	return 1;
1049	}	1049	}
1050		1050
1051	static UNOP init_perl_op;	1051	static UNOP init_perl_op;
1052		1052
1053	static void NOINLINE /* noinline to keep it out of the transfer fast path */	1053	ecb_noinline static void /* noinline to keep it out of the transfer fast path */
1054	init_perl (pTHX_ struct coro *coro)	1054	init_perl (pTHX_ struct coro *coro)
1055	{	1055	{
1056	/*	1056	/*
1057	* emulate part of the perl startup here.	1057	* emulate part of the perl startup here.
1058	*/	1058	*/
…		…
1073	PL_parser = 0;	1073	PL_parser = 0;
1074	#endif	1074	#endif
1075	PL_hints = 0;	1075	PL_hints = 0;
1076		1076
1077	/* recreate the die/warn hooks */	1077	/* recreate the die/warn hooks */
1078	PL_diehook = 0; SvSetMagicSV (*hv_fetch (hv_sig, "__DIE__" , sizeof ("__DIE__" ) - 1, 1), rv_diehook );	1078	PL_diehook = SvREFCNT_inc (rv_diehook);
1079	PL_warnhook = 0; SvSetMagicSV (*hv_fetch (hv_sig, "__WARN__", sizeof ("__WARN__") - 1, 1), rv_warnhook);	1079	PL_warnhook = SvREFCNT_inc (rv_warnhook);
1080		1080
1081	GvSV (PL_defgv) = newSV (0);	1081	GvSV (PL_defgv) = newSV (0);
1082	GvAV (PL_defgv) = coro->args; coro->args = 0;	1082	GvAV (PL_defgv) = coro->args; coro->args = 0;
1083	GvSV (PL_errgv) = newSV (0);	1083	GvSV (PL_errgv) = newSV (0);
1084	GvSV (irsgv) = newSVpvn ("\n", 1); sv_magic (GvSV (irsgv), (SV *)irsgv, PERL_MAGIC_sv, "/", 0);	1084	GvSV (irsgv) = newSVpvn ("\n", 1); sv_magic (GvSV (irsgv), (SV *)irsgv, PERL_MAGIC_sv, "/", 0);
…		…
1105	/* this newly created coroutine might be run on an existing cctx which most	1105	/* this newly created coroutine might be run on an existing cctx which most
1106	* likely was suspended in pp_slf, so we have to emulate entering pp_slf here.	1106	* likely was suspended in pp_slf, so we have to emulate entering pp_slf here.
1107	*/	1107	*/
1108	slf_frame.prepare = prepare_nop; /* provide a nop function for an eventual pp_slf */	1108	slf_frame.prepare = prepare_nop; /* provide a nop function for an eventual pp_slf */
1109	slf_frame.check = slf_check_nop; /* signal pp_slf to not repeat */	1109	slf_frame.check = slf_check_nop; /* signal pp_slf to not repeat */
		1110	slf_frame.destroy = 0;
1110		1111
1111	/* and we have to provide the pp_slf op in any case, so pp_slf can skip it */	1112	/* and we have to provide the pp_slf op in any case, so pp_slf can skip it */
1112	init_perl_op.op_next = PL_op;	1113	init_perl_op.op_next = PL_op;
1113	init_perl_op.op_type = OP_ENTERSUB;	1114	init_perl_op.op_type = OP_ENTERSUB;
1114	init_perl_op.op_ppaddr = pp_slf;	1115	init_perl_op.op_ppaddr = pp_slf;
…		…
1119	/* copy throw, in case it was set before init_perl */	1120	/* copy throw, in case it was set before init_perl */
1120	CORO_THROW = coro->except;	1121	CORO_THROW = coro->except;
1121		1122
1122	SWAP_SVS (coro);	1123	SWAP_SVS (coro);
1123		1124
1124	if (expect_false (enable_times))	1125	if (ecb_expect_false (enable_times))
1125	{	1126	{
1126	coro_times_update ();	1127	coro_times_update ();
1127	coro_times_sub (coro);	1128	coro_times_sub (coro);
1128	}	1129	}
1129	}	1130	}
…		…
1153	destroy_perl (pTHX_ struct coro *coro)	1154	destroy_perl (pTHX_ struct coro *coro)
1154	{	1155	{
1155	SV *svf [9];	1156	SV *svf [9];
1156		1157
1157	{	1158	{
		1159	SV *old_current = SvRV (coro_current);
1158	struct coro *current = SvSTATE_current;	1160	struct coro *current = SvSTATE (old_current);
1159		1161
1160	assert (("FATAL: tried to destroy currently running coroutine", coro->mainstack != PL_mainstack));	1162	assert (("FATAL: tried to destroy currently running coroutine", coro->mainstack != PL_mainstack));
1161		1163
1162	save_perl (aTHX_ current);	1164	save_perl (aTHX_ current);
		1165
		1166	/* this will cause transfer_check to croak on block*/
		1167	SvRV_set (coro_current, (SV *)coro->hv);
		1168
1163	load_perl (aTHX_ coro);	1169	load_perl (aTHX_ coro);
1164		1170
1165	coro_unwind_stacks (aTHX);	1171	coro_unwind_stacks (aTHX);
1166	coro_destruct_stacks (aTHX);
1167		1172
1168	/* restore swapped sv's */	1173	/* restore swapped sv's */
1169	SWAP_SVS (coro);	1174	SWAP_SVS (coro);
		1175
		1176	coro_destruct_stacks (aTHX);
1170		1177
1171	// now save some sv's to be free'd later	1178	// now save some sv's to be free'd later
1172	svf [0] = GvSV (PL_defgv);	1179	svf [0] = GvSV (PL_defgv);
1173	svf [1] = (SV *)GvAV (PL_defgv);	1180	svf [1] = (SV *)GvAV (PL_defgv);
1174	svf [2] = GvSV (PL_errgv);	1181	svf [2] = GvSV (PL_errgv);
…		…
1178	svf [6] = (SV *)GvHV (PL_hintgv);	1185	svf [6] = (SV *)GvHV (PL_hintgv);
1179	svf [7] = PL_diehook;	1186	svf [7] = PL_diehook;
1180	svf [8] = PL_warnhook;	1187	svf [8] = PL_warnhook;
1181	assert (9 == sizeof (svf) / sizeof (*svf));	1188	assert (9 == sizeof (svf) / sizeof (*svf));
1182		1189
		1190	SvRV_set (coro_current, old_current);
		1191
1183	load_perl (aTHX_ current);	1192	load_perl (aTHX_ current);
1184	}	1193	}
1185		1194
1186	{	1195	{
1187	unsigned int i;	1196	unsigned int i;
…		…
1194	SvREFCNT_dec (coro->invoke_cb);	1203	SvREFCNT_dec (coro->invoke_cb);
1195	SvREFCNT_dec (coro->invoke_av);	1204	SvREFCNT_dec (coro->invoke_av);
1196	}	1205	}
1197	}	1206	}
1198		1207
1199	INLINE void	1208	ECB_INLINE void
1200	free_coro_mortal (pTHX)	1209	free_coro_mortal (pTHX)
1201	{	1210	{
1202	if (expect_true (coro_mortal))	1211	if (ecb_expect_true (coro_mortal))
1203	{	1212	{
1204	SvREFCNT_dec (coro_mortal);	1213	SvREFCNT_dec ((SV *)coro_mortal);
1205	coro_mortal = 0;	1214	coro_mortal = 0;
1206	}	1215	}
1207	}	1216	}
1208		1217
1209	static int	1218	static int
…		…
1342		1351
1343	return frame->check (aTHX_ frame); /* execute the restored frame - there must be one */	1352	return frame->check (aTHX_ frame); /* execute the restored frame - there must be one */
1344	}	1353	}
1345		1354
1346	/* initialises PL_top_env and injects a pseudo-slf-call to set the stacklevel */	1355	/* initialises PL_top_env and injects a pseudo-slf-call to set the stacklevel */
1347	static void NOINLINE	1356	static void ecb_noinline
1348	cctx_prepare (pTHX)	1357	cctx_prepare (pTHX)
1349	{	1358	{
1350	PL_top_env = &PL_start_env;	1359	PL_top_env = &PL_start_env;
1351		1360
1352	if (cctx_current->flags & CC_TRACE)	1361	if (cctx_current->flags & CC_TRACE)
…		…
1363	slf_frame.prepare = slf_prepare_set_stacklevel;	1372	slf_frame.prepare = slf_prepare_set_stacklevel;
1364	slf_frame.check = slf_check_set_stacklevel;	1373	slf_frame.check = slf_check_set_stacklevel;
1365	}	1374	}
1366		1375
1367	/* the tail of transfer: execute stuff we can only do after a transfer */	1376	/* the tail of transfer: execute stuff we can only do after a transfer */
1368	INLINE void	1377	ECB_INLINE void
1369	transfer_tail (pTHX)	1378	transfer_tail (pTHX)
1370	{	1379	{
1371	free_coro_mortal (aTHX);	1380	free_coro_mortal (aTHX);
1372	}	1381	}
1373		1382
…		…
1496	cctx_destroy (coro_cctx *cctx)	1505	cctx_destroy (coro_cctx *cctx)
1497	{	1506	{
1498	if (!cctx)	1507	if (!cctx)
1499	return;	1508	return;
1500		1509
1501	assert (("FATAL: tried to destroy current cctx", cctx != cctx_current));//D temporary?	1510	assert (("FATAL: tried to destroy current cctx", cctx != cctx_current));
1502		1511
1503	--cctx_count;	1512	--cctx_count;
1504	coro_destroy (&cctx->cctx);	1513	coro_destroy (&cctx->cctx);
1505		1514
1506	/* coro_transfer creates new, empty cctx's */	1515	/* coro_transfer creates new, empty cctx's */
…		…
1525	#define CCTX_EXPIRED(cctx) ((cctx)->gen != cctx_gen || ((cctx)->flags & CC_NOREUSE))	1534	#define CCTX_EXPIRED(cctx) ((cctx)->gen != cctx_gen || ((cctx)->flags & CC_NOREUSE))
1526		1535
1527	static coro_cctx *	1536	static coro_cctx *
1528	cctx_get (pTHX)	1537	cctx_get (pTHX)
1529	{	1538	{
1530	while (expect_true (cctx_first))	1539	while (ecb_expect_true (cctx_first))
1531	{	1540	{
1532	coro_cctx *cctx = cctx_first;	1541	coro_cctx *cctx = cctx_first;
1533	cctx_first = cctx->next;	1542	cctx_first = cctx->next;
1534	--cctx_idle;	1543	--cctx_idle;
1535		1544
1536	if (expect_true (!CCTX_EXPIRED (cctx)))	1545	if (ecb_expect_true (!CCTX_EXPIRED (cctx)))
1537	return cctx;	1546	return cctx;
1538		1547
1539	cctx_destroy (cctx);	1548	cctx_destroy (cctx);
1540	}	1549	}
1541		1550
…		…
1546	cctx_put (coro_cctx *cctx)	1555	cctx_put (coro_cctx *cctx)
1547	{	1556	{
1548	assert (("FATAL: cctx_put called on non-initialised cctx in Coro (please report)", cctx->sptr));	1557	assert (("FATAL: cctx_put called on non-initialised cctx in Coro (please report)", cctx->sptr));
1549		1558
1550	/* free another cctx if overlimit */	1559	/* free another cctx if overlimit */
1551	if (expect_false (cctx_idle >= cctx_max_idle))	1560	if (ecb_expect_false (cctx_idle >= cctx_max_idle))
1552	{	1561	{
1553	coro_cctx *first = cctx_first;	1562	coro_cctx *first = cctx_first;
1554	cctx_first = first->next;	1563	cctx_first = first->next;
1555	--cctx_idle;	1564	--cctx_idle;
1556		1565
…		…
1567	static void	1576	static void
1568	transfer_check (pTHX_ struct coro *prev, struct coro *next)	1577	transfer_check (pTHX_ struct coro *prev, struct coro *next)
1569	{	1578	{
1570	/* TODO: throwing up here is considered harmful */	1579	/* TODO: throwing up here is considered harmful */
1571		1580
1572	if (expect_true (prev != next))	1581	if (ecb_expect_true (prev != next))
1573	{	1582	{
1574	if (expect_false (!(prev->flags & (CF_RUNNING | CF_NEW))))	1583	if (ecb_expect_false (!(prev->flags & (CF_RUNNING | CF_NEW))))
1575	croak ("Coro::State::transfer called with a blocked prev Coro::State, but can only transfer from running or new states,");	1584	croak ("Coro::State::transfer called with a blocked prev Coro::State, but can only transfer from running or new states,");
1576		1585
1577	if (expect_false (next->flags & (CF_RUNNING | CF_DESTROYED | CF_SUSPENDED)))	1586	if (ecb_expect_false (next->flags & (CF_RUNNING | CF_ZOMBIE | CF_SUSPENDED)))
1578	croak ("Coro::State::transfer called with running, destroyed or suspended next Coro::State, but can only transfer to inactive states,");	1587	croak ("Coro::State::transfer called with running, destroyed or suspended next Coro::State, but can only transfer to inactive states,");
1579		1588
1580	#if !PERL_VERSION_ATLEAST (5,10,0)	1589	#if !PERL_VERSION_ATLEAST (5,10,0)
1581	if (expect_false (PL_lex_state != LEX_NOTPARSING))	1590	if (ecb_expect_false (PL_lex_state != LEX_NOTPARSING))
1582	croak ("Coro::State::transfer called while parsing, but this is not supported in your perl version,");	1591	croak ("Coro::State::transfer called while parsing, but this is not supported in your perl version,");
1583	#endif	1592	#endif
1584	}	1593	}
1585	}	1594	}
1586		1595
1587	/* always use the TRANSFER macro */	1596	/* always use the TRANSFER macro */
1588	static void NOINLINE /* noinline so we have a fixed stackframe */	1597	static void ecb_noinline /* noinline so we have a fixed stackframe */
1589	transfer (pTHX_ struct coro *prev, struct coro *next, int force_cctx)	1598	transfer (pTHX_ struct coro *prev, struct coro *next, int force_cctx)
1590	{	1599	{
1591	dSTACKLEVEL;	1600	dSTACKLEVEL;
1592		1601
1593	/* sometimes transfer is only called to set idle_sp */	1602	/* sometimes transfer is only called to set idle_sp */
1594	if (expect_false (!prev))	1603	if (ecb_expect_false (!prev))
1595	{	1604	{
1596	cctx_current->idle_sp = STACKLEVEL;	1605	cctx_current->idle_sp = STACKLEVEL;
1597	assert (cctx_current->idle_te = PL_top_env); /* just for the side-effect when asserts are enabled */	1606	assert (cctx_current->idle_te = PL_top_env); /* just for the side-effect when asserts are enabled */
1598	}	1607	}
1599	else if (expect_true (prev != next))	1608	else if (ecb_expect_true (prev != next))
1600	{	1609	{
1601	coro_cctx *cctx_prev;	1610	coro_cctx *cctx_prev;
1602		1611
1603	if (expect_false (prev->flags & CF_NEW))	1612	if (ecb_expect_false (prev->flags & CF_NEW))
1604	{	1613	{
1605	/* create a new empty/source context */	1614	/* create a new empty/source context */
1606	prev->flags &= ~CF_NEW;	1615	prev->flags &= ~CF_NEW;
1607	prev->flags |= CF_RUNNING;	1616	prev->flags |= CF_RUNNING;
1608	}	1617	}
…		…
1611	next->flags |= CF_RUNNING;	1620	next->flags |= CF_RUNNING;
1612		1621
1613	/* first get rid of the old state */	1622	/* first get rid of the old state */
1614	save_perl (aTHX_ prev);	1623	save_perl (aTHX_ prev);
1615		1624
1616	if (expect_false (next->flags & CF_NEW))	1625	if (ecb_expect_false (next->flags & CF_NEW))
1617	{	1626	{
1618	/* need to start coroutine */	1627	/* need to start coroutine */
1619	next->flags &= ~CF_NEW;	1628	next->flags &= ~CF_NEW;
1620	/* setup coroutine call */	1629	/* setup coroutine call */
1621	init_perl (aTHX_ next);	1630	init_perl (aTHX_ next);
1622	}	1631	}
1623	else	1632	else
1624	load_perl (aTHX_ next);	1633	load_perl (aTHX_ next);
1625		1634
1626	/* possibly untie and reuse the cctx */	1635	/* possibly untie and reuse the cctx */
1627	if (expect_true (	1636	if (ecb_expect_true (
1628	cctx_current->idle_sp == STACKLEVEL	1637	cctx_current->idle_sp == STACKLEVEL
1629	&& !(cctx_current->flags & CC_TRACE)	1638	&& !(cctx_current->flags & CC_TRACE)
1630	&& !force_cctx	1639	&& !force_cctx
1631	))	1640	))
1632	{	1641	{
1633	/* I assume that stacklevel is a stronger indicator than PL_top_env changes */	1642	/* I assume that stacklevel is a stronger indicator than PL_top_env changes */
1634	assert (("FATAL: current top_env must equal previous top_env in Coro (please report)", PL_top_env == cctx_current->idle_te));	1643	assert (("FATAL: current top_env must equal previous top_env in Coro (please report)", PL_top_env == cctx_current->idle_te));
1635		1644
1636	/* if the cctx is about to be destroyed we need to make sure we won't see it in cctx_get. */	1645	/* if the cctx is about to be destroyed we need to make sure we won't see it in cctx_get. */
1637	/* without this the next cctx_get might destroy the running cctx while still in use */	1646	/* without this the next cctx_get might destroy the running cctx while still in use */
1638	if (expect_false (CCTX_EXPIRED (cctx_current)))	1647	if (ecb_expect_false (CCTX_EXPIRED (cctx_current)))
1639	if (expect_true (!next->cctx))	1648	if (ecb_expect_true (!next->cctx))
1640	next->cctx = cctx_get (aTHX);	1649	next->cctx = cctx_get (aTHX);
1641		1650
1642	cctx_put (cctx_current);	1651	cctx_put (cctx_current);
1643	}	1652	}
1644	else	1653	else
1645	prev->cctx = cctx_current;	1654	prev->cctx = cctx_current;
1646		1655
1647	++next->usecount;	1656	++next->usecount;
1648		1657
1649	cctx_prev = cctx_current;	1658	cctx_prev = cctx_current;
1650	cctx_current = expect_false (next->cctx) ? next->cctx : cctx_get (aTHX);	1659	cctx_current = ecb_expect_false (next->cctx) ? next->cctx : cctx_get (aTHX);
1651		1660
1652	next->cctx = 0;	1661	next->cctx = 0;
1653		1662
1654	if (expect_false (cctx_prev != cctx_current))	1663	if (ecb_expect_false (cctx_prev != cctx_current))
1655	{	1664	{
1656	cctx_prev->top_env = PL_top_env;	1665	cctx_prev->top_env = PL_top_env;
1657	PL_top_env = cctx_current->top_env;	1666	PL_top_env = cctx_current->top_env;
1658	coro_transfer (&cctx_prev->cctx, &cctx_current->cctx);	1667	coro_transfer (&cctx_prev->cctx, &cctx_current->cctx);
1659	}	1668	}
…		…
1665	#define TRANSFER(ta, force_cctx) transfer (aTHX_ (ta).prev, (ta).next, (force_cctx))	1674	#define TRANSFER(ta, force_cctx) transfer (aTHX_ (ta).prev, (ta).next, (force_cctx))
1666	#define TRANSFER_CHECK(ta) transfer_check (aTHX_ (ta).prev, (ta).next)	1675	#define TRANSFER_CHECK(ta) transfer_check (aTHX_ (ta).prev, (ta).next)
1667		1676
1668	/** high level stuff ********************************************************/	1677	/** high level stuff ********************************************************/
1669		1678
		1679	/* this function is actually Coro, not Coro::State, but we call it from here */
		1680	/* because it is convenient - but it hasn't been declared yet for that reason */
1670	static int	1681	static void
		1682	coro_call_on_destroy (pTHX_ struct coro *coro);
		1683
		1684	static void
1671	coro_state_destroy (pTHX_ struct coro *coro)	1685	coro_state_destroy (pTHX_ struct coro *coro)
1672	{	1686	{
1673	if (coro->flags & CF_DESTROYED)	1687	if (coro->flags & CF_ZOMBIE)
1674	return 0;	1688	return;
1675		1689
1676	if (coro->on_destroy && !PL_dirty)
1677	coro->on_destroy (aTHX_ coro);	1690	slf_destroy (aTHX_ coro);
1678		1691
1679	coro->flags |= CF_DESTROYED;	1692	coro->flags |= CF_ZOMBIE;
1680		1693
1681	if (coro->flags & CF_READY)	1694	if (coro->flags & CF_READY)
1682	{	1695	{
1683	/* reduce nready, as destroying a ready coro effectively unreadies it */	1696	/* reduce nready, as destroying a ready coro effectively unreadies it */
1684	/* alternative: look through all ready queues and remove the coro */	1697	/* alternative: look through all ready queues and remove the coro */
1685	--coro_nready;	1698	--coro_nready;
1686	}	1699	}
1687	else	1700	else
1688	coro->flags |= CF_READY; /* make sure it is NOT put into the readyqueue */	1701	coro->flags |= CF_READY; /* make sure it is NOT put into the readyqueue */
		1702
		1703	if (coro->next) coro->next->prev = coro->prev;
		1704	if (coro->prev) coro->prev->next = coro->next;
		1705	if (coro == coro_first) coro_first = coro->next;
1689		1706
1690	if (coro->mainstack	1707	if (coro->mainstack
1691	&& coro->mainstack != main_mainstack	1708	&& coro->mainstack != main_mainstack
1692	&& coro->slot	1709	&& coro->slot
1693	&& !PL_dirty)	1710	&& !PL_dirty)
1694	destroy_perl (aTHX_ coro);	1711	destroy_perl (aTHX_ coro);
1695		1712
1696	if (coro->next) coro->next->prev = coro->prev;
1697	if (coro->prev) coro->prev->next = coro->next;
1698	if (coro == coro_first) coro_first = coro->next;
1699
1700	cctx_destroy (coro->cctx);	1713	cctx_destroy (coro->cctx);
1701	SvREFCNT_dec (coro->startcv);	1714	SvREFCNT_dec (coro->startcv);
1702	SvREFCNT_dec (coro->args);	1715	SvREFCNT_dec (coro->args);
1703	SvREFCNT_dec (coro->swap_sv);	1716	SvREFCNT_dec (coro->swap_sv);
1704	SvREFCNT_dec (CORO_THROW);	1717	SvREFCNT_dec (CORO_THROW);
1705		1718
1706	return 1;	1719	coro_call_on_destroy (aTHX_ coro);
		1720
		1721	/* more destruction mayhem in coro_state_free */
1707	}	1722	}
1708		1723
1709	static int	1724	static int
1710	coro_state_free (pTHX_ SV *sv, MAGIC *mg)	1725	coro_state_free (pTHX_ SV *sv, MAGIC *mg)
1711	{	1726	{
1712	struct coro *coro = (struct coro *)mg->mg_ptr;	1727	struct coro *coro = (struct coro *)mg->mg_ptr;
1713	mg->mg_ptr = 0;	1728	mg->mg_ptr = 0;
1714		1729
1715	coro->hv = 0;
1716
1717	if (--coro->refcnt < 0)
1718	{
1719	coro_state_destroy (aTHX_ coro);	1730	coro_state_destroy (aTHX_ coro);
		1731	SvREFCNT_dec (coro->on_destroy);
		1732	SvREFCNT_dec (coro->status);
		1733
1720	Safefree (coro);	1734	Safefree (coro);
1721	}
1722		1735
1723	return 0;	1736	return 0;
1724	}	1737	}
1725		1738
1726	static int	1739	static int ecb_cold
1727	coro_state_dup (pTHX_ MAGIC *mg, CLONE_PARAMS *params)	1740	coro_state_dup (pTHX_ MAGIC *mg, CLONE_PARAMS *params)
1728	{	1741	{
1729	struct coro *coro = (struct coro *)mg->mg_ptr;	1742	/* called when perl clones the current process the slow way (windows process emulation) */
1730		1743	/* WE SIMply nuke the pointers in the copy, causing perl to croak */
1731	++coro->refcnt;	1744	mg->mg_ptr = 0;
		1745	mg->mg_virtual = 0;
1732		1746
1733	return 0;	1747	return 0;
1734	}	1748	}
1735		1749
1736	static MGVTBL coro_state_vtbl = {	1750	static MGVTBL coro_state_vtbl = {
…		…
1761	TRANSFER (ta, 1);	1775	TRANSFER (ta, 1);
1762	}	1776	}
1763		1777
1764	/** Coro ********************************************************************/	1778	/** Coro ********************************************************************/
1765		1779
1766	INLINE void	1780	ECB_INLINE void
1767	coro_enq (pTHX_ struct coro *coro)	1781	coro_enq (pTHX_ struct coro *coro)
1768	{	1782	{
1769	struct coro **ready = coro_ready [coro->prio - CORO_PRIO_MIN];	1783	struct coro **ready = coro_ready [coro->prio - CORO_PRIO_MIN];
1770		1784
1771	SvREFCNT_inc_NN (coro->hv);	1785	SvREFCNT_inc_NN (coro->hv);
…		…
1773	coro->next_ready = 0;	1787	coro->next_ready = 0;
1774	*(ready [0] ? &ready [1]->next_ready : &ready [0]) = coro;	1788	*(ready [0] ? &ready [1]->next_ready : &ready [0]) = coro;
1775	ready [1] = coro;	1789	ready [1] = coro;
1776	}	1790	}
1777		1791
1778	INLINE struct coro *	1792	ECB_INLINE struct coro *
1779	coro_deq (pTHX)	1793	coro_deq (pTHX)
1780	{	1794	{
1781	int prio;	1795	int prio;
1782		1796
1783	for (prio = CORO_PRIO_MAX - CORO_PRIO_MIN + 1; --prio >= 0; )	1797	for (prio = CORO_PRIO_MAX - CORO_PRIO_MIN + 1; --prio >= 0; )
…		…
1836	{	1850	{
1837	return !!(SvSTATE (coro_sv)->flags & CF_READY);	1851	return !!(SvSTATE (coro_sv)->flags & CF_READY);
1838	}	1852	}
1839		1853
1840	/* expects to own a reference to next->hv */	1854	/* expects to own a reference to next->hv */
1841	INLINE void	1855	ECB_INLINE void
1842	prepare_schedule_to (pTHX_ struct coro_transfer_args *ta, struct coro *next)	1856	prepare_schedule_to (pTHX_ struct coro_transfer_args *ta, struct coro *next)
1843	{	1857	{
1844	SV *prev_sv = SvRV (coro_current);	1858	SV *prev_sv = SvRV (coro_current);
1845		1859
1846	ta->prev = SvSTATE_hv (prev_sv);	1860	ta->prev = SvSTATE_hv (prev_sv);
…		…
1859	{	1873	{
1860	for (;;)	1874	for (;;)
1861	{	1875	{
1862	struct coro *next = coro_deq (aTHX);	1876	struct coro *next = coro_deq (aTHX);
1863		1877
1864	if (expect_true (next))	1878	if (ecb_expect_true (next))
1865	{	1879	{
1866	/* cannot transfer to destroyed coros, skip and look for next */	1880	/* cannot transfer to destroyed coros, skip and look for next */
1867	if (expect_false (next->flags & (CF_DESTROYED | CF_SUSPENDED)))	1881	if (ecb_expect_false (next->flags & (CF_ZOMBIE | CF_SUSPENDED)))
1868	SvREFCNT_dec (next->hv); /* coro_nready has already been taken care of by destroy */	1882	SvREFCNT_dec (next->hv); /* coro_nready has already been taken care of by destroy */
1869	else	1883	else
1870	{	1884	{
1871	next->flags &= ~CF_READY;	1885	next->flags &= ~CF_READY;
1872	--coro_nready;	1886	--coro_nready;
…		…
1905	}	1919	}
1906	}	1920	}
1907	}	1921	}
1908	}	1922	}
1909		1923
1910	INLINE void	1924	ECB_INLINE void
1911	prepare_cede (pTHX_ struct coro_transfer_args *ta)	1925	prepare_cede (pTHX_ struct coro_transfer_args *ta)
1912	{	1926	{
1913	api_ready (aTHX_ coro_current);	1927	api_ready (aTHX_ coro_current);
1914	prepare_schedule (aTHX_ ta);	1928	prepare_schedule (aTHX_ ta);
1915	}	1929	}
1916		1930
1917	INLINE void	1931	ECB_INLINE void
1918	prepare_cede_notself (pTHX_ struct coro_transfer_args *ta)	1932	prepare_cede_notself (pTHX_ struct coro_transfer_args *ta)
1919	{	1933	{
1920	SV *prev = SvRV (coro_current);	1934	SV *prev = SvRV (coro_current);
1921		1935
1922	if (coro_nready)	1936	if (coro_nready)
…		…
1952	{	1966	{
1953	struct coro_transfer_args ta;	1967	struct coro_transfer_args ta;
1954		1968
1955	prepare_cede (aTHX_ &ta);	1969	prepare_cede (aTHX_ &ta);
1956		1970
1957	if (expect_true (ta.prev != ta.next))	1971	if (ecb_expect_true (ta.prev != ta.next))
1958	{	1972	{
1959	TRANSFER (ta, 1);	1973	TRANSFER (ta, 1);
1960	return 1;	1974	return 1;
1961	}	1975	}
1962	else	1976	else
…		…
2005	coro->slot->runops = RUNOPS_DEFAULT;	2019	coro->slot->runops = RUNOPS_DEFAULT;
2006	}	2020	}
2007	}	2021	}
2008		2022
2009	static void	2023	static void
		2024	coro_push_av (pTHX_ AV *av, I32 gimme_v)
		2025	{
		2026	if (AvFILLp (av) >= 0 && gimme_v != G_VOID)
		2027	{
		2028	dSP;
		2029
		2030	if (gimme_v == G_SCALAR)
		2031	XPUSHs (AvARRAY (av)[AvFILLp (av)]);
		2032	else
		2033	{
		2034	int i;
		2035	EXTEND (SP, AvFILLp (av) + 1);
		2036
		2037	for (i = 0; i <= AvFILLp (av); ++i)
		2038	PUSHs (AvARRAY (av)[i]);
		2039	}
		2040
		2041	PUTBACK;
		2042	}
		2043	}
		2044
		2045	static void
		2046	coro_push_on_destroy (pTHX_ struct coro *coro, SV *cb)
		2047	{
		2048	if (!coro->on_destroy)
		2049	coro->on_destroy = newAV ();
		2050
		2051	av_push (coro->on_destroy, cb);
		2052	}
		2053
		2054	static void
		2055	slf_destroy_join (pTHX_ struct CoroSLF *frame)
		2056	{
		2057	SvREFCNT_dec ((SV *)((struct coro *)frame->data)->hv);
		2058	}
		2059
		2060	static int
		2061	slf_check_join (pTHX_ struct CoroSLF *frame)
		2062	{
		2063	struct coro *coro = (struct coro *)frame->data;
		2064
		2065	if (!coro->status)
		2066	return 1;
		2067
		2068	frame->destroy = 0;
		2069
		2070	coro_push_av (aTHX_ coro->status, GIMME_V);
		2071
		2072	SvREFCNT_dec ((SV *)coro->hv);
		2073
		2074	return 0;
		2075	}
		2076
		2077	static void
		2078	slf_init_join (pTHX_ struct CoroSLF *frame, CV *cv, SV **arg, int items)
		2079	{
		2080	struct coro *coro = SvSTATE (items > 0 ? arg [0] : &PL_sv_undef);
		2081
		2082	if (items > 1)
		2083	croak ("join called with too many arguments");
		2084
		2085	if (coro->status)
		2086	frame->prepare = prepare_nop;
		2087	else
		2088	{
		2089	coro_push_on_destroy (aTHX_ coro, SvREFCNT_inc_NN (SvRV (coro_current)));
		2090	frame->prepare = prepare_schedule;
		2091	}
		2092
		2093	frame->check = slf_check_join;
		2094	frame->destroy = slf_destroy_join;
		2095	frame->data = (void *)coro;
		2096	SvREFCNT_inc (coro->hv);
		2097	}
		2098
		2099	static void
2010	coro_call_on_destroy (pTHX_ struct coro *coro)	2100	coro_call_on_destroy (pTHX_ struct coro *coro)
2011	{	2101	{
2012	SV **on_destroyp = hv_fetch (coro->hv, "_on_destroy", sizeof ("_on_destroy") - 1, 0);	2102	AV *od = coro->on_destroy;
2013		2103
2014	if (on_destroyp)	2104	if (!od)
2015	{	2105	return;
2016	SV **statusp = hv_fetch (coro->hv, "_status", sizeof ("_status") - 1, 0);
2017	AV *on_destroy = sv_2mortal (SvREFCNT_inc ((AV *)SvRV (*on_destroyp)));
2018	AV *status = statusp ? sv_2mortal (SvREFCNT_inc ((AV *)SvRV (*statusp))) : 0;
2019		2106
2020	while (AvFILLp (on_destroy) >= 0)	2107	while (AvFILLp (od) >= 0)
		2108	{
		2109	SV *cb = sv_2mortal (av_pop (od));
		2110
		2111	/* coro hv's (and only hv's at the moment) are supported as well */
		2112	if (SvSTATEhv_p (aTHX_ cb))
		2113	api_ready (aTHX_ cb);
		2114	else
2021	{	2115	{
2022	dSP; /* don't disturb outer sp */	2116	dSP; /* don't disturb outer sp */
2023	SV *cb = av_pop (on_destroy);
2024
2025	PUSHMARK (SP);	2117	PUSHMARK (SP);
2026		2118
2027	if (statusp)	2119	if (coro->status)
2028	{	2120	{
2029	int i;	2121	PUTBACK;
2030	EXTEND (SP, AvFILLp (status) + 1);	2122	coro_push_av (aTHX_ coro->status, G_ARRAY);
2031		2123	SPAGAIN;
2032	for (i = 0; i <= AvFILLp (status); ++i)
2033	PUSHs (AvARRAY (status)[i]);
2034	}	2124	}
2035		2125
2036	PUTBACK;	2126	PUTBACK;
2037	call_sv (sv_2mortal (cb), G_VOID | G_DISCARD);	2127	call_sv (cb, G_VOID | G_DISCARD);
2038	}	2128	}
2039	}	2129	}
2040	}	2130	}
2041		2131
2042	static void	2132	static void
2043	slf_init_terminate (pTHX_ struct CoroSLF *frame, CV *cv, SV **arg, int items)	2133	coro_set_status (pTHX_ struct coro *coro, SV **arg, int items)
2044	{	2134	{
2045	int i;	2135	AV *av;
2046	HV *hv = (HV *)SvRV (coro_current);	2136
2047	AV *av = newAV ();	2137	if (coro->status)
		2138	{
		2139	av = coro->status;
		2140	av_clear (av);
		2141	}
		2142	else
		2143	av = coro->status = newAV ();
2048		2144
2049	/* items are actually not so common, so optimise for this case */	2145	/* items are actually not so common, so optimise for this case */
2050	if (items)	2146	if (items)
2051	{	2147	{
		2148	int i;
		2149
2052	av_extend (av, items - 1);	2150	av_extend (av, items - 1);
2053		2151
2054	for (i = 0; i < items; ++i)	2152	for (i = 0; i < items; ++i)
2055	av_push (av, SvREFCNT_inc_NN (arg [i]));	2153	av_push (av, SvREFCNT_inc_NN (arg [i]));
2056	}	2154	}
		2155	}
2057		2156
2058	hv_store (hv, "_status", sizeof ("_status") - 1, newRV_noinc ((SV *)av), 0);	2157	static void
2059		2158	slf_init_terminate_cancel_common (pTHX_ struct CoroSLF *frame, HV *coro_hv)
		2159	{
2060	av_push (av_destroy, (SV *)newRV_inc ((SV *)hv)); /* RVinc for perl */	2160	av_push (av_destroy, (SV *)newRV_inc ((SV *)coro_hv)); /* RVinc for perl */
2061	api_ready (aTHX_ sv_manager);	2161	api_ready (aTHX_ sv_manager);
2062		2162
2063	frame->prepare = prepare_schedule;	2163	frame->prepare = prepare_schedule;
2064	frame->check = slf_check_repeat;	2164	frame->check = slf_check_repeat;
2065		2165
2066	/* as a minor optimisation, we could unwind all stacks here */	2166	/* as a minor optimisation, we could unwind all stacks here */
2067	/* but that puts extra pressure on pp_slf, and is not worth much */	2167	/* but that puts extra pressure on pp_slf, and is not worth much */
2068	/*coro_unwind_stacks (aTHX);*/	2168	/*coro_unwind_stacks (aTHX);*/
		2169	}
		2170
		2171	static void
		2172	slf_init_terminate (pTHX_ struct CoroSLF *frame, CV *cv, SV **arg, int items)
		2173	{
		2174	HV *coro_hv = (HV *)SvRV (coro_current);
		2175
		2176	coro_set_status (aTHX_ SvSTATE ((SV *)coro_hv), arg, items);
		2177	slf_init_terminate_cancel_common (aTHX_ frame, coro_hv);
		2178	}
		2179
		2180	static void
		2181	slf_init_cancel (pTHX_ struct CoroSLF *frame, CV *cv, SV **arg, int items)
		2182	{
		2183	HV *coro_hv;
		2184	struct coro *coro;
		2185
		2186	if (items <= 0)
		2187	croak ("Coro::cancel called without coro object,");
		2188
		2189	coro = SvSTATE (arg [0]);
		2190	coro_hv = coro->hv;
		2191
		2192	coro_set_status (aTHX_ coro, arg + 1, items - 1);
		2193
		2194	if (ecb_expect_false (coro->flags & CF_NOCANCEL))
		2195	{
		2196	/* coro currently busy cancelling something, so just notify it */
		2197	coro->slf_frame.data = (void *)coro;
		2198
		2199	frame->prepare = prepare_nop;
		2200	frame->check = slf_check_nop;
		2201	}
		2202	else if (coro_hv == (HV *)SvRV (coro_current))
		2203	{
		2204	/* cancelling the current coro is allowed, and equals terminate */
		2205	slf_init_terminate_cancel_common (aTHX_ frame, coro_hv);
		2206	}
		2207	else
		2208	{
		2209	struct coro *self = SvSTATE_current;
		2210
		2211	/* otherwise we cancel directly, purely for speed reasons
		2212	* unfortunately, this requires some magic trickery, as
		2213	* somebody else could cancel us, so we have to fight the cancellation.
		2214	* this is ugly, and hopefully fully worth the extra speed.
		2215	* besides, I can't get the slow-but-safe version working...
		2216	*/
		2217	slf_frame.data = 0;
		2218	self->flags |= CF_NOCANCEL;
		2219	coro_state_destroy (aTHX_ coro);
		2220	self->flags &= ~CF_NOCANCEL;
		2221
		2222	if (slf_frame.data)
		2223	{
		2224	/* while we were busy we have been cancelled, so terminate */
		2225	slf_init_terminate_cancel_common (aTHX_ frame, self->hv);
		2226	}
		2227	else
		2228	{
		2229	frame->prepare = prepare_nop;
		2230	frame->check = slf_check_nop;
		2231	}
		2232	}
		2233	}
		2234
		2235	static int
		2236	slf_check_safe_cancel (pTHX_ struct CoroSLF *frame)
		2237	{
		2238	frame->prepare = 0;
		2239	coro_unwind_stacks (aTHX);
		2240
		2241	slf_init_terminate_cancel_common (aTHX_ frame, (HV *)SvRV (coro_current));
		2242
		2243	return 1;
		2244	}
		2245
		2246	static int
		2247	safe_cancel (pTHX_ struct coro *coro, SV **arg, int items)
		2248	{
		2249	if (coro->cctx)
		2250	croak ("coro inside C callback, unable to cancel at this time, caught");
		2251
		2252	if (coro->flags & CF_NEW)
		2253	{
		2254	coro_set_status (aTHX_ coro, arg, items);
		2255	coro_state_destroy (aTHX_ coro);
		2256	}
		2257	else
		2258	{
		2259	if (!coro->slf_frame.prepare)
		2260	croak ("coro outside an SLF function, unable to cancel at this time, caught");
		2261
		2262	slf_destroy (aTHX_ coro);
		2263
		2264	coro_set_status (aTHX_ coro, arg, items);
		2265	coro->slf_frame.prepare = prepare_nop;
		2266	coro->slf_frame.check = slf_check_safe_cancel;
		2267
		2268	api_ready (aTHX_ (SV *)coro->hv);
		2269	}
		2270
		2271	return 1;
2069	}	2272	}
2070		2273
2071	/*****************************************************************************/	2274	/*****************************************************************************/
2072	/* async pool handler */	2275	/* async pool handler */
2073		2276
…		…
2104	slf_init_pool_handler (pTHX_ struct CoroSLF *frame, CV *cv, SV **arg, int items)	2307	slf_init_pool_handler (pTHX_ struct CoroSLF *frame, CV *cv, SV **arg, int items)
2105	{	2308	{
2106	HV *hv = (HV *)SvRV (coro_current);	2309	HV *hv = (HV *)SvRV (coro_current);
2107	struct coro *coro = SvSTATE_hv ((SV *)hv);	2310	struct coro *coro = SvSTATE_hv ((SV *)hv);
2108		2311
2109	if (expect_true (coro->saved_deffh))	2312	if (ecb_expect_true (coro->saved_deffh))
2110	{	2313	{
2111	/* subsequent iteration */	2314	/* subsequent iteration */
2112	SvREFCNT_dec ((SV *)PL_defoutgv); PL_defoutgv = (GV *)coro->saved_deffh;	2315	SvREFCNT_dec ((SV *)PL_defoutgv); PL_defoutgv = (GV *)coro->saved_deffh;
2113	coro->saved_deffh = 0;	2316	coro->saved_deffh = 0;
2114		2317
2115	if (coro_rss (aTHX_ coro) > SvUV (sv_pool_rss)	2318	if (coro_rss (aTHX_ coro) > SvUV (sv_pool_rss)
2116	|| av_len (av_async_pool) + 1 >= SvIV (sv_pool_size))	2319	|| av_len (av_async_pool) + 1 >= SvIV (sv_pool_size))
2117	{	2320	{
2118	coro->invoke_cb = SvREFCNT_inc_NN ((SV *)cv_coro_terminate);	2321	slf_init_terminate_cancel_common (aTHX_ frame, hv);
2119	coro->invoke_av = newAV ();	2322	return;
2120
2121	frame->prepare = prepare_nop;
2122	}	2323	}
2123	else	2324	else
2124	{	2325	{
2125	av_clear (GvAV (PL_defgv));	2326	av_clear (GvAV (PL_defgv));
2126	hv_store (hv, "desc", sizeof ("desc") - 1, SvREFCNT_inc_NN (sv_async_pool_idle), 0);	2327	hv_store (hv, "desc", sizeof ("desc") - 1, SvREFCNT_inc_NN (sv_async_pool_idle), 0);
…		…
2349	static void	2550	static void
2350	slf_init_cede_notself (pTHX_ struct CoroSLF *frame, CV *cv, SV **arg, int items)	2551	slf_init_cede_notself (pTHX_ struct CoroSLF *frame, CV *cv, SV **arg, int items)
2351	{	2552	{
2352	frame->prepare = prepare_cede_notself;	2553	frame->prepare = prepare_cede_notself;
2353	frame->check = slf_check_nop;	2554	frame->check = slf_check_nop;
		2555	}
		2556
		2557	/* "undo"/cancel a running slf call - used when cancelling a coro, mainly */
		2558	static void
		2559	slf_destroy (pTHX_ struct coro *coro)
		2560	{
		2561	/* this callback is reserved for slf functions needing to do cleanup */
		2562	if (coro->slf_frame.destroy && coro->slf_frame.prepare && !PL_dirty)
		2563	coro->slf_frame.destroy (aTHX_ &coro->slf_frame);
		2564
		2565	/*
		2566	* The on_destroy above most likely is from an SLF call.
		2567	* Since by definition the SLF call will not finish when we destroy
		2568	* the coro, we will have to force-finish it here, otherwise
		2569	* cleanup functions cannot call SLF functions.
		2570	*/
		2571	coro->slf_frame.prepare = 0;
2354	}	2572	}
2355		2573
2356	/*	2574	/*
2357	* these not obviously related functions are all rolled into one	2575	* these not obviously related functions are all rolled into one
2358	* function to increase chances that they all will call transfer with the same	2576	* function to increase chances that they all will call transfer with the same
…		…
2365	I32 checkmark; /* mark SP to see how many elements check has pushed */	2583	I32 checkmark; /* mark SP to see how many elements check has pushed */
2366		2584
2367	/* set up the slf frame, unless it has already been set-up */	2585	/* set up the slf frame, unless it has already been set-up */
2368	/* the latter happens when a new coro has been started */	2586	/* the latter happens when a new coro has been started */
2369	/* or when a new cctx was attached to an existing coroutine */	2587	/* or when a new cctx was attached to an existing coroutine */
2370	if (expect_true (!slf_frame.prepare))	2588	if (ecb_expect_true (!slf_frame.prepare))
2371	{	2589	{
2372	/* first iteration */	2590	/* first iteration */
2373	dSP;	2591	dSP;
2374	SV **arg = PL_stack_base + TOPMARK + 1;	2592	SV **arg = PL_stack_base + TOPMARK + 1;
2375	int items = SP - arg; /* args without function object */	2593	int items = SP - arg; /* args without function object */
…		…
2416	while (slf_frame.check (aTHX_ &slf_frame));	2634	while (slf_frame.check (aTHX_ &slf_frame));
2417		2635
2418	slf_frame.prepare = 0; /* invalidate the frame, we are done processing it */	2636	slf_frame.prepare = 0; /* invalidate the frame, we are done processing it */
2419		2637
2420	/* exception handling */	2638	/* exception handling */
2421	if (expect_false (CORO_THROW))	2639	if (ecb_expect_false (CORO_THROW))
2422	{	2640	{
2423	SV *exception = sv_2mortal (CORO_THROW);	2641	SV *exception = sv_2mortal (CORO_THROW);
2424		2642
2425	CORO_THROW = 0;	2643	CORO_THROW = 0;
2426	sv_setsv (ERRSV, exception);	2644	sv_setsv (ERRSV, exception);
2427	croak (0);	2645	croak (0);
2428	}	2646	}
2429		2647
2430	/* return value handling - mostly like entersub */	2648	/* return value handling - mostly like entersub */
2431	/* make sure we put something on the stack in scalar context */	2649	/* make sure we put something on the stack in scalar context */
2432	if (GIMME_V == G_SCALAR)	2650	if (GIMME_V == G_SCALAR
		2651	&& ecb_expect_false (PL_stack_sp != PL_stack_base + checkmark + 1))
2433	{	2652	{
2434	dSP;	2653	dSP;
2435	SV **bot = PL_stack_base + checkmark;	2654	SV **bot = PL_stack_base + checkmark;
2436		2655
2437	if (sp == bot) /* too few, push undef */	2656	if (sp == bot) /* too few, push undef */
2438	bot [1] = &PL_sv_undef;	2657	bot [1] = &PL_sv_undef;
2439	else if (sp != bot + 1) /* too many, take last one */	2658	else /* too many, take last one */
2440	bot [1] = *sp;	2659	bot [1] = *sp;
2441		2660
2442	SP = bot + 1;	2661	SP = bot + 1;
2443		2662
2444	PUTBACK;	2663	PUTBACK;
…		…
2551	{	2770	{
2552	PerlIOBuf base;	2771	PerlIOBuf base;
2553	NV next, every;	2772	NV next, every;
2554	} PerlIOCede;	2773	} PerlIOCede;
2555		2774
2556	static IV	2775	static IV ecb_cold
2557	PerlIOCede_pushed (pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab)	2776	PerlIOCede_pushed (pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab)
2558	{	2777	{
2559	PerlIOCede *self = PerlIOSelf (f, PerlIOCede);	2778	PerlIOCede *self = PerlIOSelf (f, PerlIOCede);
2560		2779
2561	self->every = SvCUR (arg) ? SvNV (arg) : 0.01;	2780	self->every = SvCUR (arg) ? SvNV (arg) : 0.01;
2562	self->next = nvtime () + self->every;	2781	self->next = nvtime () + self->every;
2563		2782
2564	return PerlIOBuf_pushed (aTHX_ f, mode, Nullsv, tab);	2783	return PerlIOBuf_pushed (aTHX_ f, mode, Nullsv, tab);
2565	}	2784	}
2566		2785
2567	static SV *	2786	static SV * ecb_cold
2568	PerlIOCede_getarg (pTHX_ PerlIO *f, CLONE_PARAMS *param, int flags)	2787	PerlIOCede_getarg (pTHX_ PerlIO *f, CLONE_PARAMS *param, int flags)
2569	{	2788	{
2570	PerlIOCede *self = PerlIOSelf (f, PerlIOCede);	2789	PerlIOCede *self = PerlIOSelf (f, PerlIOCede);
2571		2790
2572	return newSVnv (self->every);	2791	return newSVnv (self->every);
…		…
2684	SvREFCNT_dec (cb);	2903	SvREFCNT_dec (cb);
2685	}	2904	}
2686	}	2905	}
2687		2906
2688	static void	2907	static void
2689	coro_semaphore_on_destroy (pTHX_ struct coro *coro)	2908	coro_semaphore_destroy (pTHX_ struct CoroSLF *frame)
2690	{	2909	{
2691	/* call $sem->adjust (0) to possibly wake up some other waiters */	2910	/* call $sem->adjust (0) to possibly wake up some other waiters */
2692	coro_semaphore_adjust (aTHX_ (AV *)coro->slf_frame.data, 0);	2911	coro_semaphore_adjust (aTHX_ (AV *)frame->data, 0);
2693	}	2912	}
2694		2913
2695	static int	2914	static int
2696	slf_check_semaphore_down_or_wait (pTHX_ struct CoroSLF *frame, int acquire)	2915	slf_check_semaphore_down_or_wait (pTHX_ struct CoroSLF *frame, int acquire)
2697	{	2916	{
2698	AV *av = (AV *)frame->data;	2917	AV *av = (AV *)frame->data;
2699	SV *count_sv = AvARRAY (av)[0];	2918	SV *count_sv = AvARRAY (av)[0];
		2919	SV *coro_hv = SvRV (coro_current);
2700		2920
2701	/* if we are about to throw, don't actually acquire the lock, just throw */	2921	/* if we are about to throw, don't actually acquire the lock, just throw */
2702	if (CORO_THROW)	2922	if (CORO_THROW)
2703	return 0;	2923	return 0;
2704	else if (SvIVX (count_sv) > 0)	2924	else if (SvIVX (count_sv) > 0)
2705	{	2925	{
2706	SvSTATE_current->on_destroy = 0;	2926	frame->destroy = 0;
2707		2927
2708	if (acquire)	2928	if (acquire)
2709	SvIVX (count_sv) = SvIVX (count_sv) - 1;	2929	SvIVX (count_sv) = SvIVX (count_sv) - 1;
2710	else	2930	else
2711	coro_semaphore_adjust (aTHX_ av, 0);	2931	coro_semaphore_adjust (aTHX_ av, 0);
…		…
2716	{	2936	{
2717	int i;	2937	int i;
2718	/* if we were woken up but can't down, we look through the whole */	2938	/* if we were woken up but can't down, we look through the whole */
2719	/* waiters list and only add us if we aren't in there already */	2939	/* waiters list and only add us if we aren't in there already */
2720	/* this avoids some degenerate memory usage cases */	2940	/* this avoids some degenerate memory usage cases */
2721		2941	for (i = AvFILLp (av); i > 0; --i) // i > 0 is not an off-by-one bug
2722	for (i = 1; i <= AvFILLp (av); ++i)
2723	if (AvARRAY (av)[i] == SvRV (coro_current))	2942	if (AvARRAY (av)[i] == coro_hv)
2724	return 1;	2943	return 1;
2725		2944
2726	av_push (av, SvREFCNT_inc (SvRV (coro_current)));	2945	av_push (av, SvREFCNT_inc (coro_hv));
2727	return 1;	2946	return 1;
2728	}	2947	}
2729	}	2948	}
2730		2949
2731	static int	2950	static int
…		…
2754	{	2973	{
2755	av_push (av, SvREFCNT_inc (SvRV (coro_current)));	2974	av_push (av, SvREFCNT_inc (SvRV (coro_current)));
2756		2975
2757	frame->data = (void *)sv_2mortal (SvREFCNT_inc ((SV *)av));	2976	frame->data = (void *)sv_2mortal (SvREFCNT_inc ((SV *)av));
2758	frame->prepare = prepare_schedule;	2977	frame->prepare = prepare_schedule;
2759
2760	/* to avoid race conditions when a woken-up coro gets terminated */	2978	/* to avoid race conditions when a woken-up coro gets terminated */
2761	/* we arrange for a temporary on_destroy that calls adjust (0) */	2979	/* we arrange for a temporary on_destroy that calls adjust (0) */
2762	SvSTATE_current->on_destroy = coro_semaphore_on_destroy;	2980	frame->destroy = coro_semaphore_destroy;
2763	}	2981	}
2764	}	2982	}
2765		2983
2766	static void	2984	static void
2767	slf_init_semaphore_down (pTHX_ struct CoroSLF *frame, CV *cv, SV **arg, int items)	2985	slf_init_semaphore_down (pTHX_ struct CoroSLF *frame, CV *cv, SV **arg, int items)
…		…
2985	dSP;	3203	dSP;
2986		3204
2987	static SV *prio_cv;	3205	static SV *prio_cv;
2988	static SV *prio_sv;	3206	static SV *prio_sv;
2989		3207
2990	if (expect_false (!prio_cv))	3208	if (ecb_expect_false (!prio_cv))
2991	{	3209	{
2992	prio_cv = (SV *)get_cv ("IO::AIO::aioreq_pri", 0);	3210	prio_cv = (SV *)get_cv ("IO::AIO::aioreq_pri", 0);
2993	prio_sv = newSViv (0);	3211	prio_sv = newSViv (0);
2994	}	3212	}
2995		3213
…		…
3100	av_push (coro->args, newSVsv (argv [i]));	3318	av_push (coro->args, newSVsv (argv [i]));
3101	}	3319	}
3102		3320
3103	return coro_sv;	3321	return coro_sv;
3104	}	3322	}
		3323
		3324	#ifndef __cplusplus
		3325	ecb_cold XS(boot_Coro__State);
		3326	#endif
3105		3327
3106	MODULE = Coro::State PACKAGE = Coro::State PREFIX = api_	3328	MODULE = Coro::State PACKAGE = Coro::State PREFIX = api_
3107		3329
3108	PROTOTYPES: DISABLE	3330	PROTOTYPES: DISABLE
3109		3331
…		…
3181	void	3403	void
3182	transfer (...)	3404	transfer (...)
3183	PROTOTYPE: $$	3405	PROTOTYPE: $$
3184	CODE:	3406	CODE:
3185	CORO_EXECUTE_SLF_XS (slf_init_transfer);	3407	CORO_EXECUTE_SLF_XS (slf_init_transfer);
3186
3187	bool
3188	_destroy (SV *coro_sv)
3189	CODE:
3190	RETVAL = coro_state_destroy (aTHX_ SvSTATE (coro_sv));
3191	OUTPUT:
3192	RETVAL
3193		3408
3194	void	3409	void
3195	_exit (int code)	3410	_exit (int code)
3196	PROTOTYPE: $	3411	PROTOTYPE: $
3197	CODE:	3412	CODE:
…		…
3273	CODE:	3488	CODE:
3274	{	3489	{
3275	if (coro->mainstack && ((coro->flags & CF_RUNNING) || coro->slot))	3490	if (coro->mainstack && ((coro->flags & CF_RUNNING) || coro->slot))
3276	{	3491	{
3277	struct coro *current = SvSTATE_current;	3492	struct coro *current = SvSTATE_current;
		3493	struct CoroSLF slf_save;
3278		3494
3279	if (current != coro)	3495	if (current != coro)
3280	{	3496	{
3281	PUTBACK;	3497	PUTBACK;
3282	save_perl (aTHX_ current);	3498	save_perl (aTHX_ current);
3283	load_perl (aTHX_ coro);	3499	load_perl (aTHX_ coro);
		3500	/* the coro is most likely in an active SLF call.
		3501	* while not strictly required (the code we execute is
		3502	* not allowed to call any SLF functions), it's cleaner
		3503	* to reinitialise the slf_frame and restore it later.
		3504	* This might one day allow us to actually do SLF calls
		3505	* from code executed here.
		3506	*/
		3507	slf_save = slf_frame;
		3508	slf_frame.prepare = 0;
3284	SPAGAIN;	3509	SPAGAIN;
3285	}	3510	}
3286		3511
3287	PUSHSTACK;	3512	PUSHSTACK;
3288		3513
…		…
3298	SPAGAIN;	3523	SPAGAIN;
3299		3524
3300	if (current != coro)	3525	if (current != coro)
3301	{	3526	{
3302	PUTBACK;	3527	PUTBACK;
		3528	slf_frame = slf_save;
3303	save_perl (aTHX_ coro);	3529	save_perl (aTHX_ coro);
3304	load_perl (aTHX_ current);	3530	load_perl (aTHX_ current);
3305	SPAGAIN;	3531	SPAGAIN;
3306	}	3532	}
3307	}	3533	}
…		…
3312	PROTOTYPE: $	3538	PROTOTYPE: $
3313	ALIAS:	3539	ALIAS:
3314	is_ready = CF_READY	3540	is_ready = CF_READY
3315	is_running = CF_RUNNING	3541	is_running = CF_RUNNING
3316	is_new = CF_NEW	3542	is_new = CF_NEW
3317	is_destroyed = CF_DESTROYED	3543	is_destroyed = CF_ZOMBIE
		3544	is_zombie = CF_ZOMBIE
3318	is_suspended = CF_SUSPENDED	3545	is_suspended = CF_SUSPENDED
3319	CODE:	3546	CODE:
3320	RETVAL = boolSV (coro->flags & ix);	3547	RETVAL = boolSV (coro->flags & ix);
3321	OUTPUT:	3548	OUTPUT:
3322	RETVAL	3549	RETVAL
…		…
3393		3620
3394	void	3621	void
3395	cancel (Coro::State self)	3622	cancel (Coro::State self)
3396	CODE:	3623	CODE:
3397	coro_state_destroy (aTHX_ self);	3624	coro_state_destroy (aTHX_ self);
3398	coro_call_on_destroy (aTHX_ self); /* actually only for Coro objects */
3399		3625
3400	SV *	3626	SV *
3401	enable_times (int enabled = enable_times)	3627	enable_times (int enabled = enable_times)
3402	CODE:	3628	CODE:
3403	{	3629	{
…		…
3418	times (Coro::State self)	3644	times (Coro::State self)
3419	PPCODE:	3645	PPCODE:
3420	{	3646	{
3421	struct coro *current = SvSTATE (coro_current);	3647	struct coro *current = SvSTATE (coro_current);
3422		3648
3423	if (expect_false (current == self))	3649	if (ecb_expect_false (current == self))
3424	{	3650	{
3425	coro_times_update ();	3651	coro_times_update ();
3426	coro_times_add (SvSTATE (coro_current));	3652	coro_times_add (SvSTATE (coro_current));
3427	}	3653	}
3428		3654
3429	EXTEND (SP, 2);	3655	EXTEND (SP, 2);
3430	PUSHs (sv_2mortal (newSVnv (self->t_real [0] + self->t_real [1] * 1e-9)));	3656	PUSHs (sv_2mortal (newSVnv (self->t_real [0] + self->t_real [1] * 1e-9)));
3431	PUSHs (sv_2mortal (newSVnv (self->t_cpu [0] + self->t_cpu [1] * 1e-9)));	3657	PUSHs (sv_2mortal (newSVnv (self->t_cpu [0] + self->t_cpu [1] * 1e-9)));
3432		3658
3433	if (expect_false (current == self))	3659	if (ecb_expect_false (current == self))
3434	coro_times_sub (SvSTATE (coro_current));	3660	coro_times_sub (SvSTATE (coro_current));
3435	}	3661	}
3436		3662
3437	void	3663	void
3438	swap_sv (Coro::State coro, SV *sv, SV *swapsv)	3664	swap_sv (Coro::State coro, SV *sv, SV *swapsv)
…		…
3459	BOOT:	3685	BOOT:
3460	{	3686	{
3461	sv_pool_rss = coro_get_sv (aTHX_ "Coro::POOL_RSS" , TRUE);	3687	sv_pool_rss = coro_get_sv (aTHX_ "Coro::POOL_RSS" , TRUE);
3462	sv_pool_size = coro_get_sv (aTHX_ "Coro::POOL_SIZE" , TRUE);	3688	sv_pool_size = coro_get_sv (aTHX_ "Coro::POOL_SIZE" , TRUE);
3463	cv_coro_run = get_cv ( "Coro::_coro_run" , GV_ADD);	3689	cv_coro_run = get_cv ( "Coro::_coro_run" , GV_ADD);
3464	cv_coro_terminate = get_cv ( "Coro::terminate" , GV_ADD);
3465	coro_current = coro_get_sv (aTHX_ "Coro::current" , FALSE); SvREADONLY_on (coro_current);	3690	coro_current = coro_get_sv (aTHX_ "Coro::current" , FALSE); SvREADONLY_on (coro_current);
3466	av_async_pool = coro_get_av (aTHX_ "Coro::async_pool", TRUE);	3691	av_async_pool = coro_get_av (aTHX_ "Coro::async_pool", TRUE);
3467	av_destroy = coro_get_av (aTHX_ "Coro::destroy" , TRUE);	3692	av_destroy = coro_get_av (aTHX_ "Coro::destroy" , TRUE);
3468	sv_manager = coro_get_sv (aTHX_ "Coro::manager" , TRUE);	3693	sv_manager = coro_get_sv (aTHX_ "Coro::manager" , TRUE);
3469	sv_idle = coro_get_sv (aTHX_ "Coro::idle" , TRUE);	3694	sv_idle = coro_get_sv (aTHX_ "Coro::idle" , TRUE);
…		…
3508	api_ready (aTHX_ RETVAL);	3733	api_ready (aTHX_ RETVAL);
3509	OUTPUT:	3734	OUTPUT:
3510	RETVAL	3735	RETVAL
3511		3736
3512	void	3737	void
		3738	_destroy (Coro::State coro)
		3739	CODE:
		3740	/* used by the manager thread */
		3741	coro_state_destroy (aTHX_ coro);
		3742
		3743	void
		3744	on_destroy (Coro::State coro, SV *cb)
		3745	CODE:
		3746	coro_push_on_destroy (aTHX_ coro, newSVsv (cb));
		3747
		3748	void
		3749	join (...)
		3750	CODE:
		3751	CORO_EXECUTE_SLF_XS (slf_init_join);
		3752
		3753	void
3513	terminate (...)	3754	terminate (...)
3514	CODE:	3755	CODE:
3515	CORO_EXECUTE_SLF_XS (slf_init_terminate);	3756	CORO_EXECUTE_SLF_XS (slf_init_terminate);
		3757
		3758	void
		3759	cancel (...)
		3760	CODE:
		3761	CORO_EXECUTE_SLF_XS (slf_init_cancel);
		3762
		3763	int
		3764	safe_cancel (Coro::State self, ...)
		3765	C_ARGS: aTHX_ self, &ST (1), items - 1
3516		3766
3517	void	3767	void
3518	schedule (...)	3768	schedule (...)
3519	CODE:	3769	CODE:
3520	CORO_EXECUTE_SLF_XS (slf_init_schedule);	3770	CORO_EXECUTE_SLF_XS (slf_init_schedule);

Diff Legend

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