ViewVC Help

View File | Revision Log | Show Annotations | Download File

/cvs/Coro/Coro/State.xs

Comparing Coro/Coro/State.xs (file contents):
Revision 1.398 by root, Sat May 7 14:11:10 2011 UTC vs.
Revision 1.406 by root, Sat Jun 11 13:49:00 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
111	static void *coro_thx;	98	static void *coro_thx;
112	# endif	99	# endif
113	#endif	100	#endif
		101
		102	/* used in state.h */
		103	#define VAR(name,type) VARx(name, PL_ ## name, type)
114		104
115	#ifdef __linux	105	#ifdef __linux
116	# include <time.h> /* for timespec */	106	# include <time.h> /* for timespec */
117	# include <syscall.h> /* for SYS_* */	107	# include <syscall.h> /* for SYS_* */
118	# ifdef SYS_clock_gettime	108	# ifdef SYS_clock_gettime
…		…
166	static char times_valid;	156	static char times_valid;
167		157
168	static struct coro_cctx *cctx_first;	158	static struct coro_cctx *cctx_first;
169	static int cctx_count, cctx_idle;	159	static int cctx_count, cctx_idle;
170		160
171	enum {	161	enum
		162	{
172	CC_MAPPED = 0x01,	163	CC_MAPPED = 0x01,
173	CC_NOREUSE = 0x02, /* throw this away after tracing */	164	CC_NOREUSE = 0x02, /* throw this away after tracing */
174	CC_TRACE = 0x04,	165	CC_TRACE = 0x04,
175	CC_TRACE_SUB = 0x08, /* trace sub calls */	166	CC_TRACE_SUB = 0x08, /* trace sub calls */
176	CC_TRACE_LINE = 0x10, /* trace each statement */	167	CC_TRACE_LINE = 0x10, /* trace each statement */
…		…
201		192
202	static coro_cctx *cctx_current; /* the currently running cctx */	193	static coro_cctx *cctx_current; /* the currently running cctx */
203		194
204	/*****************************************************************************/	195	/*****************************************************************************/
205		196
		197	static MGVTBL coro_state_vtbl;
		198
206	enum {	199	enum
		200	{
207	CF_RUNNING = 0x0001, /* coroutine is running */	201	CF_RUNNING = 0x0001, /* coroutine is running */
208	CF_READY = 0x0002, /* coroutine is ready */	202	CF_READY = 0x0002, /* coroutine is ready */
209	CF_NEW = 0x0004, /* has never been switched to */	203	CF_NEW = 0x0004, /* has never been switched to */
210	CF_DESTROYED = 0x0008, /* coroutine data has been freed */	204	CF_ZOMBIE = 0x0008, /* coroutine data has been freed */
211	CF_SUSPENDED = 0x0010, /* coroutine can't be scheduled */	205	CF_SUSPENDED = 0x0010, /* coroutine can't be scheduled */
212	CF_NOCANCEL = 0x0020, /* cannot cancel, set slf_frame.data to 1 (hackish) */	206	CF_NOCANCEL = 0x0020, /* cannot cancel, set slf_frame.data to 1 (hackish) */
213	};	207	};
214		208
215	/* the structure where most of the perl state is stored, overlaid on the cxstack */	209	/* the structure where most of the perl state is stored, overlaid on the cxstack */
216	typedef struct	210	typedef struct
217	{	211	{
218	SV *defsv;
219	AV *defav;
220	SV *errsv;
221	SV *irsgv;
222	HV *hinthv;
223	#define VAR(name,type) type name;	212	#define VARx(name,expr,type) type name;
224	# include "state.h"	213	# include "state.h"
225	#undef VAR	214	#undef VARx
226	} perl_slots;	215	} perl_slots;
227		216
228	// how many context stack entries do we need for perl_slots	217	// how many context stack entries do we need for perl_slots
229	#define SLOT_COUNT ((sizeof (perl_slots) + sizeof (PERL_CONTEXT) - 1) / sizeof (PERL_CONTEXT))	218	#define SLOT_COUNT ((sizeof (perl_slots) + sizeof (PERL_CONTEXT) - 1) / sizeof (PERL_CONTEXT))
230		219
231	/* this is a structure representing a perl-level coroutine */	220	/* this is a structure representing a perl-level coroutine */
232	struct coro {	221	struct coro
		222	{
233	/* the C coroutine allocated to this perl coroutine, if any */	223	/* the C coroutine allocated to this perl coroutine, if any */
234	coro_cctx *cctx;	224	coro_cctx *cctx;
235		225
236	/* ready queue */	226	/* ready queue */
237	struct coro *next_ready;	227	struct coro *next_ready;
…		…
239	/* state data */	229	/* state data */
240	struct CoroSLF slf_frame; /* saved slf frame */	230	struct CoroSLF slf_frame; /* saved slf frame */
241	AV *mainstack;	231	AV *mainstack;
242	perl_slots *slot; /* basically the saved sp */	232	perl_slots *slot; /* basically the saved sp */
243		233
244	CV *startcv; /* the CV to execute */	234	CV *startcv; /* the CV to execute */
245	AV *args; /* data associated with this coroutine (initial args) */	235	AV *args; /* data associated with this coroutine (initial args) */
246	int refcnt; /* coroutines are refcounted, yes */
247	int flags; /* CF_ flags */	236	int flags; /* CF_ flags */
248	HV *hv; /* the perl hash associated with this coro, if any */	237	HV *hv; /* the perl hash associated with this coro, if any */
249		238
250	/* statistics */	239	/* statistics */
251	int usecount; /* number of transfers to this coro */	240	int usecount; /* number of transfers to this coro */
252		241
253	/* coro process data */	242	/* coro process data */
254	int prio;	243	int prio;
255	SV *except; /* exception to be thrown */	244	SV *except; /* exception to be thrown */
256	SV *rouse_cb;	245	SV *rouse_cb; /* last rouse callback */
		246	AV *on_destroy; /* callbacks or coros to notify on destroy */
		247	AV *status; /* the exit status list */
257		248
258	/* async_pool */	249	/* async_pool */
259	SV *saved_deffh;	250	SV *saved_deffh;
260	SV *invoke_cb;	251	SV *invoke_cb;
261	AV *invoke_av;	252	AV *invoke_av;
…		…
297	static struct coro *coro_ready [CORO_PRIO_MAX - CORO_PRIO_MIN + 1][2]; /* head|tail */	288	static struct coro *coro_ready [CORO_PRIO_MAX - CORO_PRIO_MIN + 1][2]; /* head|tail */
298	static CV *cv_coro_run;	289	static CV *cv_coro_run;
299	static struct coro *coro_first;	290	static struct coro *coro_first;
300	#define coro_nready coroapi.nready	291	#define coro_nready coroapi.nready
301		292
		293	/** JIT *********************************************************************/
		294
		295	#if CORO_JIT
		296	#ifndef CORO_JIT_TYPE
		297	#if __x86_64 && (__linux || __FreeBSD__ || __OpenBSD__ || __NetBSD__ || __solaris)
		298	#define CORO_JIT_TYPE "amd64-unix"
		299	typedef void (*load_save_perl_slots_type)(perl_slots *);
		300	#else
		301	#undef CORO_JIT
		302	#endif
		303	#endif
		304	#endif
		305
		306	#if CORO_JIT
		307	static load_save_perl_slots_type load_perl_slots, save_perl_slots;
		308	#endif
		309
302	/** Coro::Select ************************************************************/	310	/** Coro::Select ************************************************************/
303		311
304	static OP *(*coro_old_pp_sselect) (pTHX);	312	static OP *(*coro_old_pp_sselect) (pTHX);
305	static SV *coro_select_select;	313	static SV *coro_select_select;
306		314
…		…
321		329
322	/** time stuff **************************************************************/	330	/** time stuff **************************************************************/
323		331
324	#ifdef HAS_GETTIMEOFDAY	332	#ifdef HAS_GETTIMEOFDAY
325		333
326	static void	334	ECB_INLINE void
327	coro_u2time (pTHX_ UV ret[2])	335	coro_u2time (pTHX_ UV ret[2])
328	{	336	{
329	struct timeval tv;	337	struct timeval tv;
330	gettimeofday (&tv, 0);	338	gettimeofday (&tv, 0);
331		339
332	ret [0] = tv.tv_sec;	340	ret [0] = tv.tv_sec;
333	ret [1] = tv.tv_usec;	341	ret [1] = tv.tv_usec;
334	}	342	}
335		343
336	static double	344	ECB_INLINE double
337	coro_nvtime ()	345	coro_nvtime ()
338	{	346	{
339	struct timeval tv;	347	struct timeval tv;
340	gettimeofday (&tv, 0);	348	gettimeofday (&tv, 0);
341		349
342	return tv.tv_sec + tv.tv_usec * 1e-6;	350	return tv.tv_sec + tv.tv_usec * 1e-6;
343	}	351	}
344		352
345	static void	353	ECB_INLINE void
346	time_init (pTHX)	354	time_init (pTHX)
347	{	355	{
348	nvtime = coro_nvtime;	356	nvtime = coro_nvtime;
349	u2time = coro_u2time;	357	u2time = coro_u2time;
350	}	358	}
351		359
352	#else	360	#else
353		361
354	static void	362	ECB_INLINE void
355	time_init (pTHX)	363	time_init (pTHX)
356	{	364	{
357	SV **svp;	365	SV **svp;
358		366
359	require_pv ("Time/HiRes.pm");	367	require_pv ("Time/HiRes.pm");
…		…
371		379
372	#endif	380	#endif
373		381
374	/** lowlevel stuff **********************************************************/	382	/** lowlevel stuff **********************************************************/
375		383
376	static SV *	384	static SV * ecb_noinline
377	coro_get_sv (pTHX_ const char *name, int create)	385	coro_get_sv (pTHX_ const char *name, int create)
378	{	386	{
379	#if PERL_VERSION_ATLEAST (5,10,0)	387	#if PERL_VERSION_ATLEAST (5,10,0)
380	/* silence stupid and wrong 5.10 warning that I am unable to switch off */	388	/* silence stupid and wrong 5.10 warning that I am unable to switch off */
381	get_sv (name, create);	389	get_sv (name, create);
382	#endif	390	#endif
383	return get_sv (name, create);	391	return get_sv (name, create);
384	}	392	}
385		393
386	static AV *	394	static AV * ecb_noinline
387	coro_get_av (pTHX_ const char *name, int create)	395	coro_get_av (pTHX_ const char *name, int create)
388	{	396	{
389	#if PERL_VERSION_ATLEAST (5,10,0)	397	#if PERL_VERSION_ATLEAST (5,10,0)
390	/* silence stupid and wrong 5.10 warning that I am unable to switch off */	398	/* silence stupid and wrong 5.10 warning that I am unable to switch off */
391	get_av (name, create);	399	get_av (name, create);
392	#endif	400	#endif
393	return get_av (name, create);	401	return get_av (name, create);
394	}	402	}
395		403
396	static HV *	404	static HV * ecb_noinline
397	coro_get_hv (pTHX_ const char *name, int create)	405	coro_get_hv (pTHX_ const char *name, int create)
398	{	406	{
399	#if PERL_VERSION_ATLEAST (5,10,0)	407	#if PERL_VERSION_ATLEAST (5,10,0)
400	/* silence stupid and wrong 5.10 warning that I am unable to switch off */	408	/* silence stupid and wrong 5.10 warning that I am unable to switch off */
401	get_hv (name, create);	409	get_hv (name, create);
402	#endif	410	#endif
403	return get_hv (name, create);	411	return get_hv (name, create);
404	}	412	}
405		413
406	INLINE void	414	ECB_INLINE void
407	coro_times_update ()	415	coro_times_update ()
408	{	416	{
409	#ifdef coro_clock_gettime	417	#ifdef coro_clock_gettime
410	struct timespec ts;	418	struct timespec ts;
411		419
…		…
424	time_real [0] = tv [0];	432	time_real [0] = tv [0];
425	time_real [1] = tv [1] * 1000;	433	time_real [1] = tv [1] * 1000;
426	#endif	434	#endif
427	}	435	}
428		436
429	INLINE void	437	ECB_INLINE void
430	coro_times_add (struct coro *c)	438	coro_times_add (struct coro *c)
431	{	439	{
432	c->t_real [1] += time_real [1];	440	c->t_real [1] += time_real [1];
433	if (c->t_real [1] > 1000000000) { c->t_real [1] -= 1000000000; ++c->t_real [0]; }	441	if (c->t_real [1] > 1000000000) { c->t_real [1] -= 1000000000; ++c->t_real [0]; }
434	c->t_real [0] += time_real [0];	442	c->t_real [0] += time_real [0];
…		…
436	c->t_cpu [1] += time_cpu [1];	444	c->t_cpu [1] += time_cpu [1];
437	if (c->t_cpu [1] > 1000000000) { c->t_cpu [1] -= 1000000000; ++c->t_cpu [0]; }	445	if (c->t_cpu [1] > 1000000000) { c->t_cpu [1] -= 1000000000; ++c->t_cpu [0]; }
438	c->t_cpu [0] += time_cpu [0];	446	c->t_cpu [0] += time_cpu [0];
439	}	447	}
440		448
441	INLINE void	449	ECB_INLINE void
442	coro_times_sub (struct coro *c)	450	coro_times_sub (struct coro *c)
443	{	451	{
444	if (c->t_real [1] < time_real [1]) { c->t_real [1] += 1000000000; --c->t_real [0]; }	452	if (c->t_real [1] < time_real [1]) { c->t_real [1] += 1000000000; --c->t_real [0]; }
445	c->t_real [1] -= time_real [1];	453	c->t_real [1] -= time_real [1];
446	c->t_real [0] -= time_real [0];	454	c->t_real [0] -= time_real [0];
…		…
454	/* magic glue */	462	/* magic glue */
455		463
456	#define CORO_MAGIC_type_cv 26	464	#define CORO_MAGIC_type_cv 26
457	#define CORO_MAGIC_type_state PERL_MAGIC_ext	465	#define CORO_MAGIC_type_state PERL_MAGIC_ext
458		466
459	#define CORO_MAGIC_NN(sv, type) \	467	#define CORO_MAGIC_NN(sv, type) \
460	(expect_true (SvMAGIC (sv)->mg_type == type) \	468	(ecb_expect_true (SvMAGIC (sv)->mg_type == type) \
461	? SvMAGIC (sv) \	469	? SvMAGIC (sv) \
462	: mg_find (sv, type))	470	: mg_find (sv, type))
463		471
464	#define CORO_MAGIC(sv, type) \	472	#define CORO_MAGIC(sv, type) \
465	(expect_true (SvMAGIC (sv)) \	473	(ecb_expect_true (SvMAGIC (sv)) \
466	? CORO_MAGIC_NN (sv, type) \	474	? CORO_MAGIC_NN (sv, type) \
467	: 0)	475	: 0)
468		476
469	#define CORO_MAGIC_cv(cv) CORO_MAGIC (((SV *)(cv)), CORO_MAGIC_type_cv)	477	#define CORO_MAGIC_cv(cv) CORO_MAGIC (((SV *)(cv)), CORO_MAGIC_type_cv)
470	#define CORO_MAGIC_state(sv) CORO_MAGIC_NN (((SV *)(sv)), CORO_MAGIC_type_state)	478	#define CORO_MAGIC_state(sv) CORO_MAGIC_NN (((SV *)(sv)), CORO_MAGIC_type_state)
471		479
		480	ECB_INLINE MAGIC *
		481	SvSTATEhv_p (pTHX_ SV *coro)
		482	{
		483	MAGIC *mg;
		484
		485	if (ecb_expect_true (
		486	SvTYPE (coro) == SVt_PVHV
		487	&& (mg = CORO_MAGIC_state (coro))
		488	&& mg->mg_virtual == &coro_state_vtbl
		489	))
		490	return mg;
		491
		492	return 0;
		493	}
		494
472	INLINE struct coro *	495	ECB_INLINE struct coro *
473	SvSTATE_ (pTHX_ SV *coro)	496	SvSTATE_ (pTHX_ SV *coro)
474	{	497	{
475	HV *stash;
476	MAGIC *mg;	498	MAGIC *mg;
477		499
478	if (SvROK (coro))	500	if (SvROK (coro))
479	coro = SvRV (coro);	501	coro = SvRV (coro);
480		502
481	if (expect_false (SvTYPE (coro) != SVt_PVHV))	503	mg = SvSTATEhv_p (aTHX_ coro);
		504	if (!mg)
482	croak ("Coro::State object required");	505	croak ("Coro::State object required");
483		506
484	stash = SvSTASH (coro);
485	if (expect_false (stash != coro_stash && stash != coro_state_stash))
486	{
487	/* very slow, but rare, check */
488	if (!sv_derived_from (sv_2mortal (newRV_inc (coro)), "Coro::State"))
489	croak ("Coro::State object required");
490	}
491
492	mg = CORO_MAGIC_state (coro);
493	return (struct coro *)mg->mg_ptr;	507	return (struct coro *)mg->mg_ptr;
494	}	508	}
495		509
496	#define SvSTATE(sv) SvSTATE_ (aTHX_ (sv))	510	#define SvSTATE(sv) SvSTATE_ (aTHX_ (sv))
497		511
…		…
500	#define SvSTATE_current SvSTATE_hv (SvRV (coro_current))	514	#define SvSTATE_current SvSTATE_hv (SvRV (coro_current))
501		515
502	/*****************************************************************************/	516	/*****************************************************************************/
503	/* padlist management and caching */	517	/* padlist management and caching */
504		518
505	static AV *	519	ECB_INLINE AV *
506	coro_derive_padlist (pTHX_ CV *cv)	520	coro_derive_padlist (pTHX_ CV *cv)
507	{	521	{
508	AV *padlist = CvPADLIST (cv);	522	AV *padlist = CvPADLIST (cv);
509	AV *newpadlist, *newpad;	523	AV *newpadlist, *newpad;
510		524
…		…
522	av_store (newpadlist, 1, (SV *)newpad);	536	av_store (newpadlist, 1, (SV *)newpad);
523		537
524	return newpadlist;	538	return newpadlist;
525	}	539	}
526		540
527	static void	541	ECB_INLINE void
528	free_padlist (pTHX_ AV *padlist)	542	free_padlist (pTHX_ AV *padlist)
529	{	543	{
530	/* may be during global destruction */	544	/* may be during global destruction */
531	if (!IN_DESTRUCT)	545	if (!IN_DESTRUCT)
532	{	546	{
…		…
575	0, 0, 0, 0,	589	0, 0, 0, 0,
576	coro_cv_free	590	coro_cv_free
577	};	591	};
578		592
579	/* the next two functions merely cache the padlists */	593	/* the next two functions merely cache the padlists */
580	static void	594	ECB_INLINE void
581	get_padlist (pTHX_ CV *cv)	595	get_padlist (pTHX_ CV *cv)
582	{	596	{
583	MAGIC *mg = CORO_MAGIC_cv (cv);	597	MAGIC *mg = CORO_MAGIC_cv (cv);
584	AV *av;	598	AV *av;
585		599
586	if (expect_true (mg && AvFILLp ((av = (AV *)mg->mg_obj)) >= 0))	600	if (ecb_expect_true (mg && AvFILLp ((av = (AV *)mg->mg_obj)) >= 0))
587	CvPADLIST (cv) = (AV *)AvARRAY (av)[AvFILLp (av)--];	601	CvPADLIST (cv) = (AV *)AvARRAY (av)[AvFILLp (av)--];
588	else	602	else
589	{	603	{
590	#if CORO_PREFER_PERL_FUNCTIONS	604	#if CORO_PREFER_PERL_FUNCTIONS
591	/* this is probably cleaner? but also slower! */	605	/* this is probably cleaner? but also slower! */
…		…
598	CvPADLIST (cv) = coro_derive_padlist (aTHX_ cv);	612	CvPADLIST (cv) = coro_derive_padlist (aTHX_ cv);
599	#endif	613	#endif
600	}	614	}
601	}	615	}
602		616
603	static void	617	ECB_INLINE void
604	put_padlist (pTHX_ CV *cv)	618	put_padlist (pTHX_ CV *cv)
605	{	619	{
606	MAGIC *mg = CORO_MAGIC_cv (cv);	620	MAGIC *mg = CORO_MAGIC_cv (cv);
607	AV *av;	621	AV *av;
608		622
609	if (expect_false (!mg))	623	if (ecb_expect_false (!mg))
610	mg = sv_magicext ((SV *)cv, (SV *)newAV (), CORO_MAGIC_type_cv, &coro_cv_vtbl, 0, 0);	624	mg = sv_magicext ((SV *)cv, (SV *)newAV (), CORO_MAGIC_type_cv, &coro_cv_vtbl, 0, 0);
611		625
612	av = (AV *)mg->mg_obj;	626	av = (AV *)mg->mg_obj;
613		627
614	if (expect_false (AvFILLp (av) >= AvMAX (av)))	628	if (ecb_expect_false (AvFILLp (av) >= AvMAX (av)))
615	av_extend (av, AvFILLp (av) + 1);	629	av_extend (av, AvFILLp (av) + 1);
616		630
617	AvARRAY (av)[++AvFILLp (av)] = (SV *)CvPADLIST (cv);	631	AvARRAY (av)[++AvFILLp (av)] = (SV *)CvPADLIST (cv);
618	}	632	}
619		633
…		…
664	}	678	}
665	#endif	679	#endif
666	}	680	}
667	}	681	}
668		682
669	#define SWAP_SVS(coro) \	683	#define SWAP_SVS(coro) \
670	if (expect_false ((coro)->swap_sv)) \	684	if (ecb_expect_false ((coro)->swap_sv)) \
671	swap_svs (aTHX_ (coro))	685	swap_svs (aTHX_ (coro))
672		686
673	static void	687	static void
674	on_enterleave_call (pTHX_ SV *cb);	688	on_enterleave_call (pTHX_ SV *cb);
675		689
…		…
679	perl_slots *slot = c->slot;	693	perl_slots *slot = c->slot;
680	c->slot = 0;	694	c->slot = 0;
681		695
682	PL_mainstack = c->mainstack;	696	PL_mainstack = c->mainstack;
683		697
684	GvSV (PL_defgv) = slot->defsv;	698	#if CORO_JIT
685	GvAV (PL_defgv) = slot->defav;	699	load_perl_slots (slot);
686	GvSV (PL_errgv) = slot->errsv;	700	#else
687	GvSV (irsgv) = slot->irsgv;
688	GvHV (PL_hintgv) = slot->hinthv;
689
690	#define VAR(name,type) PL_ ## name = slot->name;	701	#define VARx(name,expr,type) expr = slot->name;
691	# include "state.h"	702	# include "state.h"
692	#undef VAR	703	#undef VARx
		704	#endif
693		705
694	{	706	{
695	dSP;	707	dSP;
696		708
697	CV *cv;	709	CV *cv;
698		710
699	/* now do the ugly restore mess */	711	/* now do the ugly restore mess */
700	while (expect_true (cv = (CV *)POPs))	712	while (ecb_expect_true (cv = (CV *)POPs))
701	{	713	{
702	put_padlist (aTHX_ cv); /* mark this padlist as available */	714	put_padlist (aTHX_ cv); /* mark this padlist as available */
703	CvDEPTH (cv) = PTR2IV (POPs);	715	CvDEPTH (cv) = PTR2IV (POPs);
704	CvPADLIST (cv) = (AV *)POPs;	716	CvPADLIST (cv) = (AV *)POPs;
705	}	717	}
…		…
708	}	720	}
709		721
710	slf_frame = c->slf_frame;	722	slf_frame = c->slf_frame;
711	CORO_THROW = c->except;	723	CORO_THROW = c->except;
712		724
713	if (expect_false (enable_times))	725	if (ecb_expect_false (enable_times))
714	{	726	{
715	if (expect_false (!times_valid))	727	if (ecb_expect_false (!times_valid))
716	coro_times_update ();	728	coro_times_update ();
717		729
718	coro_times_sub (c);	730	coro_times_sub (c);
719	}	731	}
720		732
721	if (expect_false (c->on_enter))	733	if (ecb_expect_false (c->on_enter))
722	{	734	{
723	int i;	735	int i;
724		736
725	for (i = 0; i <= AvFILLp (c->on_enter); ++i)	737	for (i = 0; i <= AvFILLp (c->on_enter); ++i)
726	on_enterleave_call (aTHX_ AvARRAY (c->on_enter)[i]);	738	on_enterleave_call (aTHX_ AvARRAY (c->on_enter)[i]);
…		…
732	static void	744	static void
733	save_perl (pTHX_ Coro__State c)	745	save_perl (pTHX_ Coro__State c)
734	{	746	{
735	SWAP_SVS (c);	747	SWAP_SVS (c);
736		748
737	if (expect_false (c->on_leave))	749	if (ecb_expect_false (c->on_leave))
738	{	750	{
739	int i;	751	int i;
740		752
741	for (i = AvFILLp (c->on_leave); i >= 0; --i)	753	for (i = AvFILLp (c->on_leave); i >= 0; --i)
742	on_enterleave_call (aTHX_ AvARRAY (c->on_leave)[i]);	754	on_enterleave_call (aTHX_ AvARRAY (c->on_leave)[i]);
743	}	755	}
744		756
745	times_valid = 0;	757	times_valid = 0;
746		758
747	if (expect_false (enable_times))	759	if (ecb_expect_false (enable_times))
748	{	760	{
749	coro_times_update (); times_valid = 1;	761	coro_times_update (); times_valid = 1;
750	coro_times_add (c);	762	coro_times_add (c);
751	}	763	}
752		764
…		…
766		778
767	XPUSHs (Nullsv);	779	XPUSHs (Nullsv);
768	/* this loop was inspired by pp_caller */	780	/* this loop was inspired by pp_caller */
769	for (;;)	781	for (;;)
770	{	782	{
771	while (expect_true (cxix >= 0))	783	while (ecb_expect_true (cxix >= 0))
772	{	784	{
773	PERL_CONTEXT *cx = &ccstk[cxix--];	785	PERL_CONTEXT *cx = &ccstk[cxix--];
774		786
775	if (expect_true (CxTYPE (cx) == CXt_SUB) || expect_false (CxTYPE (cx) == CXt_FORMAT))	787	if (ecb_expect_true (CxTYPE (cx) == CXt_SUB) || ecb_expect_false (CxTYPE (cx) == CXt_FORMAT))
776	{	788	{
777	CV *cv = cx->blk_sub.cv;	789	CV *cv = cx->blk_sub.cv;
778		790
779	if (expect_true (CvDEPTH (cv)))	791	if (ecb_expect_true (CvDEPTH (cv)))
780	{	792	{
781	EXTEND (SP, 3);	793	EXTEND (SP, 3);
782	PUSHs ((SV *)CvPADLIST (cv));	794	PUSHs ((SV *)CvPADLIST (cv));
783	PUSHs (INT2PTR (SV *, (IV)CvDEPTH (cv)));	795	PUSHs (INT2PTR (SV *, (IV)CvDEPTH (cv)));
784	PUSHs ((SV *)cv);	796	PUSHs ((SV *)cv);
…		…
787	get_padlist (aTHX_ cv);	799	get_padlist (aTHX_ cv);
788	}	800	}
789	}	801	}
790	}	802	}
791		803
792	if (expect_true (top_si->si_type == PERLSI_MAIN))	804	if (ecb_expect_true (top_si->si_type == PERLSI_MAIN))
793	break;	805	break;
794		806
795	top_si = top_si->si_prev;	807	top_si = top_si->si_prev;
796	ccstk = top_si->si_cxstack;	808	ccstk = top_si->si_cxstack;
797	cxix = top_si->si_cxix;	809	cxix = top_si->si_cxix;
…		…
799		811
800	PUTBACK;	812	PUTBACK;
801	}	813	}
802		814
803	/* allocate some space on the context stack for our purposes */	815	/* allocate some space on the context stack for our purposes */
804	if (expect_false (cxstack_ix + SLOT_COUNT >= cxstack_max))	816	if (ecb_expect_false (cxstack_ix + SLOT_COUNT >= cxstack_max))
805	{	817	{
806	unsigned int i;	818	unsigned int i;
807		819
808	for (i = 0; i < SLOT_COUNT; ++i)	820	for (i = 0; i < SLOT_COUNT; ++i)
809	CXINC;	821	CXINC;
…		…
814	c->mainstack = PL_mainstack;	826	c->mainstack = PL_mainstack;
815		827
816	{	828	{
817	perl_slots *slot = c->slot = (perl_slots *)(cxstack + cxstack_ix + 1);	829	perl_slots *slot = c->slot = (perl_slots *)(cxstack + cxstack_ix + 1);
818		830
819	slot->defav = GvAV (PL_defgv);	831	#if CORO_JIT
820	slot->defsv = DEFSV;	832	save_perl_slots (slot);
821	slot->errsv = ERRSV;	833	#else
822	slot->irsgv = GvSV (irsgv);
823	slot->hinthv = GvHV (PL_hintgv);
824
825	#define VAR(name,type) slot->name = PL_ ## name;	834	#define VARx(name,expr,type) slot->name = expr;
826	# include "state.h"	835	# include "state.h"
827	#undef VAR	836	#undef VARx
		837	#endif
828	}	838	}
829	}	839	}
830		840
831	/*	841	/*
832	* allocate various perl stacks. This is almost an exact copy	842	* allocate various perl stacks. This is almost an exact copy
…		…
955	#endif	965	#endif
956		966
957	/*	967	/*
958	* This overrides the default magic get method of %SIG elements.	968	* This overrides the default magic get method of %SIG elements.
959	* The original one doesn't provide for reading back of PL_diehook/PL_warnhook	969	* The original one doesn't provide for reading back of PL_diehook/PL_warnhook
960	* and instead of trying to save and restore the hash elements, we just provide	970	* and instead of trying to save and restore the hash elements (extremely slow),
961	* readback here.	971	* we just provide our own readback here.
962	*/	972	*/
963	static int	973	static int ecb_cold
964	coro_sigelem_get (pTHX_ SV *sv, MAGIC *mg)	974	coro_sigelem_get (pTHX_ SV *sv, MAGIC *mg)
965	{	975	{
966	const char *s = MgPV_nolen_const (mg);	976	const char *s = MgPV_nolen_const (mg);
967		977
968	if (*s == '_')	978	if (*s == '_')
…		…
980	}	990	}
981		991
982	return orig_sigelem_get ? orig_sigelem_get (aTHX_ sv, mg) : 0;	992	return orig_sigelem_get ? orig_sigelem_get (aTHX_ sv, mg) : 0;
983	}	993	}
984		994
985	static int	995	static int ecb_cold
986	coro_sigelem_clr (pTHX_ SV *sv, MAGIC *mg)	996	coro_sigelem_clr (pTHX_ SV *sv, MAGIC *mg)
987	{	997	{
988	const char *s = MgPV_nolen_const (mg);	998	const char *s = MgPV_nolen_const (mg);
989		999
990	if (*s == '_')	1000	if (*s == '_')
…		…
1004	}	1014	}
1005		1015
1006	return orig_sigelem_clr ? orig_sigelem_clr (aTHX_ sv, mg) : 0;	1016	return orig_sigelem_clr ? orig_sigelem_clr (aTHX_ sv, mg) : 0;
1007	}	1017	}
1008		1018
1009	static int	1019	static int ecb_cold
1010	coro_sigelem_set (pTHX_ SV *sv, MAGIC *mg)	1020	coro_sigelem_set (pTHX_ SV *sv, MAGIC *mg)
1011	{	1021	{
1012	const char *s = MgPV_nolen_const (mg);	1022	const char *s = MgPV_nolen_const (mg);
1013		1023
1014	if (*s == '_')	1024	if (*s == '_')
…		…
1049	return 1;	1059	return 1;
1050	}	1060	}
1051		1061
1052	static UNOP init_perl_op;	1062	static UNOP init_perl_op;
1053		1063
1054	static void NOINLINE /* noinline to keep it out of the transfer fast path */	1064	ecb_noinline static void /* noinline to keep it out of the transfer fast path */
1055	init_perl (pTHX_ struct coro *coro)	1065	init_perl (pTHX_ struct coro *coro)
1056	{	1066	{
1057	/*	1067	/*
1058	* emulate part of the perl startup here.	1068	* emulate part of the perl startup here.
1059	*/	1069	*/
…		…
1074	PL_parser = 0;	1084	PL_parser = 0;
1075	#endif	1085	#endif
1076	PL_hints = 0;	1086	PL_hints = 0;
1077		1087
1078	/* recreate the die/warn hooks */	1088	/* recreate the die/warn hooks */
1079	PL_diehook = 0; SvSetMagicSV (*hv_fetch (hv_sig, "__DIE__" , sizeof ("__DIE__" ) - 1, 1), rv_diehook );	1089	PL_diehook = SvREFCNT_inc (rv_diehook);
1080	PL_warnhook = 0; SvSetMagicSV (*hv_fetch (hv_sig, "__WARN__", sizeof ("__WARN__") - 1, 1), rv_warnhook);	1090	PL_warnhook = SvREFCNT_inc (rv_warnhook);
1081		1091
1082	GvSV (PL_defgv) = newSV (0);	1092	GvSV (PL_defgv) = newSV (0);
1083	GvAV (PL_defgv) = coro->args; coro->args = 0;	1093	GvAV (PL_defgv) = coro->args; coro->args = 0;
1084	GvSV (PL_errgv) = newSV (0);	1094	GvSV (PL_errgv) = newSV (0);
1085	GvSV (irsgv) = newSVpvn ("\n", 1); sv_magic (GvSV (irsgv), (SV *)irsgv, PERL_MAGIC_sv, "/", 0);	1095	GvSV (irsgv) = newSVpvn ("\n", 1); sv_magic (GvSV (irsgv), (SV *)irsgv, PERL_MAGIC_sv, "/", 0);
…		…
1106	/* this newly created coroutine might be run on an existing cctx which most	1116	/* this newly created coroutine might be run on an existing cctx which most
1107	* likely was suspended in pp_slf, so we have to emulate entering pp_slf here.	1117	* likely was suspended in pp_slf, so we have to emulate entering pp_slf here.
1108	*/	1118	*/
1109	slf_frame.prepare = prepare_nop; /* provide a nop function for an eventual pp_slf */	1119	slf_frame.prepare = prepare_nop; /* provide a nop function for an eventual pp_slf */
1110	slf_frame.check = slf_check_nop; /* signal pp_slf to not repeat */	1120	slf_frame.check = slf_check_nop; /* signal pp_slf to not repeat */
		1121	slf_frame.destroy = 0;
1111		1122
1112	/* and we have to provide the pp_slf op in any case, so pp_slf can skip it */	1123	/* and we have to provide the pp_slf op in any case, so pp_slf can skip it */
1113	init_perl_op.op_next = PL_op;	1124	init_perl_op.op_next = PL_op;
1114	init_perl_op.op_type = OP_ENTERSUB;	1125	init_perl_op.op_type = OP_ENTERSUB;
1115	init_perl_op.op_ppaddr = pp_slf;	1126	init_perl_op.op_ppaddr = pp_slf;
…		…
1120	/* copy throw, in case it was set before init_perl */	1131	/* copy throw, in case it was set before init_perl */
1121	CORO_THROW = coro->except;	1132	CORO_THROW = coro->except;
1122		1133
1123	SWAP_SVS (coro);	1134	SWAP_SVS (coro);
1124		1135
1125	if (expect_false (enable_times))	1136	if (ecb_expect_false (enable_times))
1126	{	1137	{
1127	coro_times_update ();	1138	coro_times_update ();
1128	coro_times_sub (coro);	1139	coro_times_sub (coro);
1129	}	1140	}
1130	}	1141	}
…		…
1167	SvRV_set (coro_current, (SV *)coro->hv);	1178	SvRV_set (coro_current, (SV *)coro->hv);
1168		1179
1169	load_perl (aTHX_ coro);	1180	load_perl (aTHX_ coro);
1170		1181
1171	coro_unwind_stacks (aTHX);	1182	coro_unwind_stacks (aTHX);
1172	coro_destruct_stacks (aTHX);
1173		1183
1174	/* restore swapped sv's */	1184	/* restore swapped sv's */
1175	SWAP_SVS (coro);	1185	SWAP_SVS (coro);
		1186
		1187	coro_destruct_stacks (aTHX);
1176		1188
1177	// now save some sv's to be free'd later	1189	// now save some sv's to be free'd later
1178	svf [0] = GvSV (PL_defgv);	1190	svf [0] = GvSV (PL_defgv);
1179	svf [1] = (SV *)GvAV (PL_defgv);	1191	svf [1] = (SV *)GvAV (PL_defgv);
1180	svf [2] = GvSV (PL_errgv);	1192	svf [2] = GvSV (PL_errgv);
…		…
1202	SvREFCNT_dec (coro->invoke_cb);	1214	SvREFCNT_dec (coro->invoke_cb);
1203	SvREFCNT_dec (coro->invoke_av);	1215	SvREFCNT_dec (coro->invoke_av);
1204	}	1216	}
1205	}	1217	}
1206		1218
1207	INLINE void	1219	ECB_INLINE void
1208	free_coro_mortal (pTHX)	1220	free_coro_mortal (pTHX)
1209	{	1221	{
1210	if (expect_true (coro_mortal))	1222	if (ecb_expect_true (coro_mortal))
1211	{	1223	{
1212	SvREFCNT_dec (coro_mortal);	1224	SvREFCNT_dec ((SV *)coro_mortal);
1213	coro_mortal = 0;	1225	coro_mortal = 0;
1214	}	1226	}
1215	}	1227	}
1216		1228
1217	static int	1229	static int
…		…
1350		1362
1351	return frame->check (aTHX_ frame); /* execute the restored frame - there must be one */	1363	return frame->check (aTHX_ frame); /* execute the restored frame - there must be one */
1352	}	1364	}
1353		1365
1354	/* initialises PL_top_env and injects a pseudo-slf-call to set the stacklevel */	1366	/* initialises PL_top_env and injects a pseudo-slf-call to set the stacklevel */
1355	static void NOINLINE	1367	static void ecb_noinline
1356	cctx_prepare (pTHX)	1368	cctx_prepare (pTHX)
1357	{	1369	{
1358	PL_top_env = &PL_start_env;	1370	PL_top_env = &PL_start_env;
1359		1371
1360	if (cctx_current->flags & CC_TRACE)	1372	if (cctx_current->flags & CC_TRACE)
…		…
1371	slf_frame.prepare = slf_prepare_set_stacklevel;	1383	slf_frame.prepare = slf_prepare_set_stacklevel;
1372	slf_frame.check = slf_check_set_stacklevel;	1384	slf_frame.check = slf_check_set_stacklevel;
1373	}	1385	}
1374		1386
1375	/* the tail of transfer: execute stuff we can only do after a transfer */	1387	/* the tail of transfer: execute stuff we can only do after a transfer */
1376	INLINE void	1388	ECB_INLINE void
1377	transfer_tail (pTHX)	1389	transfer_tail (pTHX)
1378	{	1390	{
1379	free_coro_mortal (aTHX);	1391	free_coro_mortal (aTHX);
1380	}	1392	}
1381		1393
…		…
1533	#define CCTX_EXPIRED(cctx) ((cctx)->gen != cctx_gen || ((cctx)->flags & CC_NOREUSE))	1545	#define CCTX_EXPIRED(cctx) ((cctx)->gen != cctx_gen || ((cctx)->flags & CC_NOREUSE))
1534		1546
1535	static coro_cctx *	1547	static coro_cctx *
1536	cctx_get (pTHX)	1548	cctx_get (pTHX)
1537	{	1549	{
1538	while (expect_true (cctx_first))	1550	while (ecb_expect_true (cctx_first))
1539	{	1551	{
1540	coro_cctx *cctx = cctx_first;	1552	coro_cctx *cctx = cctx_first;
1541	cctx_first = cctx->next;	1553	cctx_first = cctx->next;
1542	--cctx_idle;	1554	--cctx_idle;
1543		1555
1544	if (expect_true (!CCTX_EXPIRED (cctx)))	1556	if (ecb_expect_true (!CCTX_EXPIRED (cctx)))
1545	return cctx;	1557	return cctx;
1546		1558
1547	cctx_destroy (cctx);	1559	cctx_destroy (cctx);
1548	}	1560	}
1549		1561
…		…
1554	cctx_put (coro_cctx *cctx)	1566	cctx_put (coro_cctx *cctx)
1555	{	1567	{
1556	assert (("FATAL: cctx_put called on non-initialised cctx in Coro (please report)", cctx->sptr));	1568	assert (("FATAL: cctx_put called on non-initialised cctx in Coro (please report)", cctx->sptr));
1557		1569
1558	/* free another cctx if overlimit */	1570	/* free another cctx if overlimit */
1559	if (expect_false (cctx_idle >= cctx_max_idle))	1571	if (ecb_expect_false (cctx_idle >= cctx_max_idle))
1560	{	1572	{
1561	coro_cctx *first = cctx_first;	1573	coro_cctx *first = cctx_first;
1562	cctx_first = first->next;	1574	cctx_first = first->next;
1563	--cctx_idle;	1575	--cctx_idle;
1564		1576
…		…
1575	static void	1587	static void
1576	transfer_check (pTHX_ struct coro *prev, struct coro *next)	1588	transfer_check (pTHX_ struct coro *prev, struct coro *next)
1577	{	1589	{
1578	/* TODO: throwing up here is considered harmful */	1590	/* TODO: throwing up here is considered harmful */
1579		1591
1580	if (expect_true (prev != next))	1592	if (ecb_expect_true (prev != next))
1581	{	1593	{
1582	if (expect_false (!(prev->flags & (CF_RUNNING | CF_NEW))))	1594	if (ecb_expect_false (!(prev->flags & (CF_RUNNING | CF_NEW))))
1583	croak ("Coro::State::transfer called with a blocked prev Coro::State, but can only transfer from running or new states,");	1595	croak ("Coro::State::transfer called with a blocked prev Coro::State, but can only transfer from running or new states,");
1584		1596
1585	if (expect_false (next->flags & (CF_RUNNING | CF_DESTROYED | CF_SUSPENDED)))	1597	if (ecb_expect_false (next->flags & (CF_RUNNING | CF_ZOMBIE | CF_SUSPENDED)))
1586	croak ("Coro::State::transfer called with running, destroyed or suspended next Coro::State, but can only transfer to inactive states,");	1598	croak ("Coro::State::transfer called with running, destroyed or suspended next Coro::State, but can only transfer to inactive states,");
1587		1599
1588	#if !PERL_VERSION_ATLEAST (5,10,0)	1600	#if !PERL_VERSION_ATLEAST (5,10,0)
1589	if (expect_false (PL_lex_state != LEX_NOTPARSING))	1601	if (ecb_expect_false (PL_lex_state != LEX_NOTPARSING))
1590	croak ("Coro::State::transfer called while parsing, but this is not supported in your perl version,");	1602	croak ("Coro::State::transfer called while parsing, but this is not supported in your perl version,");
1591	#endif	1603	#endif
1592	}	1604	}
1593	}	1605	}
1594		1606
1595	/* always use the TRANSFER macro */	1607	/* always use the TRANSFER macro */
1596	static void NOINLINE /* noinline so we have a fixed stackframe */	1608	static void ecb_noinline /* noinline so we have a fixed stackframe */
1597	transfer (pTHX_ struct coro *prev, struct coro *next, int force_cctx)	1609	transfer (pTHX_ struct coro *prev, struct coro *next, int force_cctx)
1598	{	1610	{
1599	dSTACKLEVEL;	1611	dSTACKLEVEL;
1600		1612
1601	/* sometimes transfer is only called to set idle_sp */	1613	/* sometimes transfer is only called to set idle_sp */
1602	if (expect_false (!prev))	1614	if (ecb_expect_false (!prev))
1603	{	1615	{
1604	cctx_current->idle_sp = STACKLEVEL;	1616	cctx_current->idle_sp = STACKLEVEL;
1605	assert (cctx_current->idle_te = PL_top_env); /* just for the side-effect when asserts are enabled */	1617	assert (cctx_current->idle_te = PL_top_env); /* just for the side-effect when asserts are enabled */
1606	}	1618	}
1607	else if (expect_true (prev != next))	1619	else if (ecb_expect_true (prev != next))
1608	{	1620	{
1609	coro_cctx *cctx_prev;	1621	coro_cctx *cctx_prev;
1610		1622
1611	if (expect_false (prev->flags & CF_NEW))	1623	if (ecb_expect_false (prev->flags & CF_NEW))
1612	{	1624	{
1613	/* create a new empty/source context */	1625	/* create a new empty/source context */
1614	prev->flags &= ~CF_NEW;	1626	prev->flags &= ~CF_NEW;
1615	prev->flags |= CF_RUNNING;	1627	prev->flags |= CF_RUNNING;
1616	}	1628	}
…		…
1619	next->flags |= CF_RUNNING;	1631	next->flags |= CF_RUNNING;
1620		1632
1621	/* first get rid of the old state */	1633	/* first get rid of the old state */
1622	save_perl (aTHX_ prev);	1634	save_perl (aTHX_ prev);
1623		1635
1624	if (expect_false (next->flags & CF_NEW))	1636	if (ecb_expect_false (next->flags & CF_NEW))
1625	{	1637	{
1626	/* need to start coroutine */	1638	/* need to start coroutine */
1627	next->flags &= ~CF_NEW;	1639	next->flags &= ~CF_NEW;
1628	/* setup coroutine call */	1640	/* setup coroutine call */
1629	init_perl (aTHX_ next);	1641	init_perl (aTHX_ next);
1630	}	1642	}
1631	else	1643	else
1632	load_perl (aTHX_ next);	1644	load_perl (aTHX_ next);
1633		1645
1634	/* possibly untie and reuse the cctx */	1646	/* possibly untie and reuse the cctx */
1635	if (expect_true (	1647	if (ecb_expect_true (
1636	cctx_current->idle_sp == STACKLEVEL	1648	cctx_current->idle_sp == STACKLEVEL
1637	&& !(cctx_current->flags & CC_TRACE)	1649	&& !(cctx_current->flags & CC_TRACE)
1638	&& !force_cctx	1650	&& !force_cctx
1639	))	1651	))
1640	{	1652	{
1641	/* I assume that stacklevel is a stronger indicator than PL_top_env changes */	1653	/* I assume that stacklevel is a stronger indicator than PL_top_env changes */
1642	assert (("FATAL: current top_env must equal previous top_env in Coro (please report)", PL_top_env == cctx_current->idle_te));	1654	assert (("FATAL: current top_env must equal previous top_env in Coro (please report)", PL_top_env == cctx_current->idle_te));
1643		1655
1644	/* if the cctx is about to be destroyed we need to make sure we won't see it in cctx_get. */	1656	/* if the cctx is about to be destroyed we need to make sure we won't see it in cctx_get. */
1645	/* without this the next cctx_get might destroy the running cctx while still in use */	1657	/* without this the next cctx_get might destroy the running cctx while still in use */
1646	if (expect_false (CCTX_EXPIRED (cctx_current)))	1658	if (ecb_expect_false (CCTX_EXPIRED (cctx_current)))
1647	if (expect_true (!next->cctx))	1659	if (ecb_expect_true (!next->cctx))
1648	next->cctx = cctx_get (aTHX);	1660	next->cctx = cctx_get (aTHX);
1649		1661
1650	cctx_put (cctx_current);	1662	cctx_put (cctx_current);
1651	}	1663	}
1652	else	1664	else
1653	prev->cctx = cctx_current;	1665	prev->cctx = cctx_current;
1654		1666
1655	++next->usecount;	1667	++next->usecount;
1656		1668
1657	cctx_prev = cctx_current;	1669	cctx_prev = cctx_current;
1658	cctx_current = expect_false (next->cctx) ? next->cctx : cctx_get (aTHX);	1670	cctx_current = ecb_expect_false (next->cctx) ? next->cctx : cctx_get (aTHX);
1659		1671
1660	next->cctx = 0;	1672	next->cctx = 0;
1661		1673
1662	if (expect_false (cctx_prev != cctx_current))	1674	if (ecb_expect_false (cctx_prev != cctx_current))
1663	{	1675	{
1664	cctx_prev->top_env = PL_top_env;	1676	cctx_prev->top_env = PL_top_env;
1665	PL_top_env = cctx_current->top_env;	1677	PL_top_env = cctx_current->top_env;
1666	coro_transfer (&cctx_prev->cctx, &cctx_current->cctx);	1678	coro_transfer (&cctx_prev->cctx, &cctx_current->cctx);
1667	}	1679	}
…		…
1673	#define TRANSFER(ta, force_cctx) transfer (aTHX_ (ta).prev, (ta).next, (force_cctx))	1685	#define TRANSFER(ta, force_cctx) transfer (aTHX_ (ta).prev, (ta).next, (force_cctx))
1674	#define TRANSFER_CHECK(ta) transfer_check (aTHX_ (ta).prev, (ta).next)	1686	#define TRANSFER_CHECK(ta) transfer_check (aTHX_ (ta).prev, (ta).next)
1675		1687
1676	/** high level stuff ********************************************************/	1688	/** high level stuff ********************************************************/
1677		1689
		1690	/* this function is actually Coro, not Coro::State, but we call it from here */
		1691	/* because it is convenient - but it hasn't been declared yet for that reason */
		1692	static void
		1693	coro_call_on_destroy (pTHX_ struct coro *coro);
		1694
1678	static void	1695	static void
1679	coro_state_destroy (pTHX_ struct coro *coro)	1696	coro_state_destroy (pTHX_ struct coro *coro)
1680	{	1697	{
1681	if (coro->flags & CF_DESTROYED)	1698	if (coro->flags & CF_ZOMBIE)
1682	return;	1699	return;
1683		1700
1684	slf_destroy (aTHX_ coro);	1701	slf_destroy (aTHX_ coro);
1685		1702
1686	coro->flags |= CF_DESTROYED;	1703	coro->flags |= CF_ZOMBIE;
1687		1704
1688	if (coro->flags & CF_READY)	1705	if (coro->flags & CF_READY)
1689	{	1706	{
1690	/* reduce nready, as destroying a ready coro effectively unreadies it */	1707	/* reduce nready, as destroying a ready coro effectively unreadies it */
1691	/* alternative: look through all ready queues and remove the coro */	1708	/* alternative: look through all ready queues and remove the coro */
1692	--coro_nready;	1709	--coro_nready;
1693	}	1710	}
1694	else	1711	else
1695	coro->flags |= CF_READY; /* make sure it is NOT put into the readyqueue */	1712	coro->flags |= CF_READY; /* make sure it is NOT put into the readyqueue */
		1713
		1714	if (coro->next) coro->next->prev = coro->prev;
		1715	if (coro->prev) coro->prev->next = coro->next;
		1716	if (coro == coro_first) coro_first = coro->next;
1696		1717
1697	if (coro->mainstack	1718	if (coro->mainstack
1698	&& coro->mainstack != main_mainstack	1719	&& coro->mainstack != main_mainstack
1699	&& coro->slot	1720	&& coro->slot
1700	&& !PL_dirty)	1721	&& !PL_dirty)
1701	destroy_perl (aTHX_ coro);	1722	destroy_perl (aTHX_ coro);
1702		1723
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;
1706
1707	cctx_destroy (coro->cctx);	1724	cctx_destroy (coro->cctx);
1708	SvREFCNT_dec (coro->startcv);	1725	SvREFCNT_dec (coro->startcv);
1709	SvREFCNT_dec (coro->args);	1726	SvREFCNT_dec (coro->args);
1710	SvREFCNT_dec (coro->swap_sv);	1727	SvREFCNT_dec (coro->swap_sv);
1711	SvREFCNT_dec (CORO_THROW);	1728	SvREFCNT_dec (CORO_THROW);
		1729
		1730	coro_call_on_destroy (aTHX_ coro);
		1731
		1732	/* more destruction mayhem in coro_state_free */
1712	}	1733	}
1713		1734
1714	static int	1735	static int
1715	coro_state_free (pTHX_ SV *sv, MAGIC *mg)	1736	coro_state_free (pTHX_ SV *sv, MAGIC *mg)
1716	{	1737	{
1717	struct coro *coro = (struct coro *)mg->mg_ptr;	1738	struct coro *coro = (struct coro *)mg->mg_ptr;
1718	mg->mg_ptr = 0;	1739	mg->mg_ptr = 0;
1719		1740
1720	coro->hv = 0;
1721
1722	if (--coro->refcnt < 0)
1723	{
1724	coro_state_destroy (aTHX_ coro);	1741	coro_state_destroy (aTHX_ coro);
		1742	SvREFCNT_dec (coro->on_destroy);
		1743	SvREFCNT_dec (coro->status);
		1744
1725	Safefree (coro);	1745	Safefree (coro);
1726	}
1727		1746
1728	return 0;	1747	return 0;
1729	}	1748	}
1730		1749
1731	static int	1750	static int ecb_cold
1732	coro_state_dup (pTHX_ MAGIC *mg, CLONE_PARAMS *params)	1751	coro_state_dup (pTHX_ MAGIC *mg, CLONE_PARAMS *params)
1733	{	1752	{
1734	struct coro *coro = (struct coro *)mg->mg_ptr;	1753	/* called when perl clones the current process the slow way (windows process emulation) */
1735		1754	/* WE SIMply nuke the pointers in the copy, causing perl to croak */
1736	++coro->refcnt;	1755	mg->mg_ptr = 0;
		1756	mg->mg_virtual = 0;
1737		1757
1738	return 0;	1758	return 0;
1739	}	1759	}
1740		1760
1741	static MGVTBL coro_state_vtbl = {	1761	static MGVTBL coro_state_vtbl = {
…		…
1766	TRANSFER (ta, 1);	1786	TRANSFER (ta, 1);
1767	}	1787	}
1768		1788
1769	/** Coro ********************************************************************/	1789	/** Coro ********************************************************************/
1770		1790
1771	INLINE void	1791	ECB_INLINE void
1772	coro_enq (pTHX_ struct coro *coro)	1792	coro_enq (pTHX_ struct coro *coro)
1773	{	1793	{
1774	struct coro **ready = coro_ready [coro->prio - CORO_PRIO_MIN];	1794	struct coro **ready = coro_ready [coro->prio - CORO_PRIO_MIN];
1775		1795
1776	SvREFCNT_inc_NN (coro->hv);	1796	SvREFCNT_inc_NN (coro->hv);
…		…
1778	coro->next_ready = 0;	1798	coro->next_ready = 0;
1779	*(ready [0] ? &ready [1]->next_ready : &ready [0]) = coro;	1799	*(ready [0] ? &ready [1]->next_ready : &ready [0]) = coro;
1780	ready [1] = coro;	1800	ready [1] = coro;
1781	}	1801	}
1782		1802
1783	INLINE struct coro *	1803	ECB_INLINE struct coro *
1784	coro_deq (pTHX)	1804	coro_deq (pTHX)
1785	{	1805	{
1786	int prio;	1806	int prio;
1787		1807
1788	for (prio = CORO_PRIO_MAX - CORO_PRIO_MIN + 1; --prio >= 0; )	1808	for (prio = CORO_PRIO_MAX - CORO_PRIO_MIN + 1; --prio >= 0; )
…		…
1841	{	1861	{
1842	return !!(SvSTATE (coro_sv)->flags & CF_READY);	1862	return !!(SvSTATE (coro_sv)->flags & CF_READY);
1843	}	1863	}
1844		1864
1845	/* expects to own a reference to next->hv */	1865	/* expects to own a reference to next->hv */
1846	INLINE void	1866	ECB_INLINE void
1847	prepare_schedule_to (pTHX_ struct coro_transfer_args *ta, struct coro *next)	1867	prepare_schedule_to (pTHX_ struct coro_transfer_args *ta, struct coro *next)
1848	{	1868	{
1849	SV *prev_sv = SvRV (coro_current);	1869	SV *prev_sv = SvRV (coro_current);
1850		1870
1851	ta->prev = SvSTATE_hv (prev_sv);	1871	ta->prev = SvSTATE_hv (prev_sv);
…		…
1864	{	1884	{
1865	for (;;)	1885	for (;;)
1866	{	1886	{
1867	struct coro *next = coro_deq (aTHX);	1887	struct coro *next = coro_deq (aTHX);
1868		1888
1869	if (expect_true (next))	1889	if (ecb_expect_true (next))
1870	{	1890	{
1871	/* cannot transfer to destroyed coros, skip and look for next */	1891	/* cannot transfer to destroyed coros, skip and look for next */
1872	if (expect_false (next->flags & (CF_DESTROYED | CF_SUSPENDED)))	1892	if (ecb_expect_false (next->flags & (CF_ZOMBIE | CF_SUSPENDED)))
1873	SvREFCNT_dec (next->hv); /* coro_nready has already been taken care of by destroy */	1893	SvREFCNT_dec (next->hv); /* coro_nready has already been taken care of by destroy */
1874	else	1894	else
1875	{	1895	{
1876	next->flags &= ~CF_READY;	1896	next->flags &= ~CF_READY;
1877	--coro_nready;	1897	--coro_nready;
…		…
1910	}	1930	}
1911	}	1931	}
1912	}	1932	}
1913	}	1933	}
1914		1934
1915	INLINE void	1935	ECB_INLINE void
1916	prepare_cede (pTHX_ struct coro_transfer_args *ta)	1936	prepare_cede (pTHX_ struct coro_transfer_args *ta)
1917	{	1937	{
1918	api_ready (aTHX_ coro_current);	1938	api_ready (aTHX_ coro_current);
1919	prepare_schedule (aTHX_ ta);	1939	prepare_schedule (aTHX_ ta);
1920	}	1940	}
1921		1941
1922	INLINE void	1942	ECB_INLINE void
1923	prepare_cede_notself (pTHX_ struct coro_transfer_args *ta)	1943	prepare_cede_notself (pTHX_ struct coro_transfer_args *ta)
1924	{	1944	{
1925	SV *prev = SvRV (coro_current);	1945	SV *prev = SvRV (coro_current);
1926		1946
1927	if (coro_nready)	1947	if (coro_nready)
…		…
1957	{	1977	{
1958	struct coro_transfer_args ta;	1978	struct coro_transfer_args ta;
1959		1979
1960	prepare_cede (aTHX_ &ta);	1980	prepare_cede (aTHX_ &ta);
1961		1981
1962	if (expect_true (ta.prev != ta.next))	1982	if (ecb_expect_true (ta.prev != ta.next))
1963	{	1983	{
1964	TRANSFER (ta, 1);	1984	TRANSFER (ta, 1);
1965	return 1;	1985	return 1;
1966	}	1986	}
1967	else	1987	else
…		…
2010	coro->slot->runops = RUNOPS_DEFAULT;	2030	coro->slot->runops = RUNOPS_DEFAULT;
2011	}	2031	}
2012	}	2032	}
2013		2033
2014	static void	2034	static void
		2035	coro_push_av (pTHX_ AV *av, I32 gimme_v)
		2036	{
		2037	if (AvFILLp (av) >= 0 && gimme_v != G_VOID)
		2038	{
		2039	dSP;
		2040
		2041	if (gimme_v == G_SCALAR)
		2042	XPUSHs (AvARRAY (av)[AvFILLp (av)]);
		2043	else
		2044	{
		2045	int i;
		2046	EXTEND (SP, AvFILLp (av) + 1);
		2047
		2048	for (i = 0; i <= AvFILLp (av); ++i)
		2049	PUSHs (AvARRAY (av)[i]);
		2050	}
		2051
		2052	PUTBACK;
		2053	}
		2054	}
		2055
		2056	static void
		2057	coro_push_on_destroy (pTHX_ struct coro *coro, SV *cb)
		2058	{
		2059	if (!coro->on_destroy)
		2060	coro->on_destroy = newAV ();
		2061
		2062	av_push (coro->on_destroy, cb);
		2063	}
		2064
		2065	static void
		2066	slf_destroy_join (pTHX_ struct CoroSLF *frame)
		2067	{
		2068	SvREFCNT_dec ((SV *)((struct coro *)frame->data)->hv);
		2069	}
		2070
		2071	static int
		2072	slf_check_join (pTHX_ struct CoroSLF *frame)
		2073	{
		2074	struct coro *coro = (struct coro *)frame->data;
		2075
		2076	if (!coro->status)
		2077	return 1;
		2078
		2079	frame->destroy = 0;
		2080
		2081	coro_push_av (aTHX_ coro->status, GIMME_V);
		2082
		2083	SvREFCNT_dec ((SV *)coro->hv);
		2084
		2085	return 0;
		2086	}
		2087
		2088	static void
		2089	slf_init_join (pTHX_ struct CoroSLF *frame, CV *cv, SV **arg, int items)
		2090	{
		2091	struct coro *coro = SvSTATE (items > 0 ? arg [0] : &PL_sv_undef);
		2092
		2093	if (items > 1)
		2094	croak ("join called with too many arguments");
		2095
		2096	if (coro->status)
		2097	frame->prepare = prepare_nop;
		2098	else
		2099	{
		2100	coro_push_on_destroy (aTHX_ coro, SvREFCNT_inc_NN (SvRV (coro_current)));
		2101	frame->prepare = prepare_schedule;
		2102	}
		2103
		2104	frame->check = slf_check_join;
		2105	frame->destroy = slf_destroy_join;
		2106	frame->data = (void *)coro;
		2107	SvREFCNT_inc (coro->hv);
		2108	}
		2109
		2110	static void
2015	coro_call_on_destroy (pTHX_ struct coro *coro)	2111	coro_call_on_destroy (pTHX_ struct coro *coro)
2016	{	2112	{
2017	SV **on_destroyp = hv_fetch (coro->hv, "_on_destroy", sizeof ("_on_destroy") - 1, 0);	2113	AV *od = coro->on_destroy;
2018		2114
2019	if (on_destroyp)	2115	if (!od)
2020	{	2116	return;
2021	SV **statusp = hv_fetch (coro->hv, "_status", sizeof ("_status") - 1, 0);
2022	AV *on_destroy = sv_2mortal (SvREFCNT_inc ((AV *)SvRV (*on_destroyp)));
2023	AV *status = statusp ? sv_2mortal (SvREFCNT_inc ((AV *)SvRV (*statusp))) : 0;
2024		2117
2025	while (AvFILLp (on_destroy) >= 0)	2118	while (AvFILLp (od) >= 0)
		2119	{
		2120	SV *cb = sv_2mortal (av_pop (od));
		2121
		2122	/* coro hv's (and only hv's at the moment) are supported as well */
		2123	if (SvSTATEhv_p (aTHX_ cb))
		2124	api_ready (aTHX_ cb);
		2125	else
2026	{	2126	{
2027	dSP; /* don't disturb outer sp */	2127	dSP; /* don't disturb outer sp */
2028	SV *cb = av_pop (on_destroy);
2029
2030	PUSHMARK (SP);	2128	PUSHMARK (SP);
2031		2129
2032	if (statusp)	2130	if (coro->status)
2033	{	2131	{
2034	int i;	2132	PUTBACK;
2035	EXTEND (SP, AvFILLp (status) + 1);	2133	coro_push_av (aTHX_ coro->status, G_ARRAY);
2036		2134	SPAGAIN;
2037	for (i = 0; i <= AvFILLp (status); ++i)
2038	PUSHs (AvARRAY (status)[i]);
2039	}	2135	}
2040		2136
2041	PUTBACK;	2137	PUTBACK;
2042	call_sv (sv_2mortal (cb), G_VOID | G_DISCARD);	2138	call_sv (cb, G_VOID | G_DISCARD);
2043	}	2139	}
2044	}	2140	}
2045	}	2141	}
2046		2142
2047	static void	2143	static void
2048	coro_set_status (pTHX_ HV *coro_hv, SV **arg, int items)	2144	coro_set_status (pTHX_ struct coro *coro, SV **arg, int items)
2049	{	2145	{
2050	AV *av = newAV ();	2146	AV *av;
		2147
		2148	if (coro->status)
		2149	{
		2150	av = coro->status;
		2151	av_clear (av);
		2152	}
		2153	else
		2154	av = coro->status = newAV ();
2051		2155
2052	/* items are actually not so common, so optimise for this case */	2156	/* items are actually not so common, so optimise for this case */
2053	if (items)	2157	if (items)
2054	{	2158	{
2055	int i;	2159	int i;
…		…
2057	av_extend (av, items - 1);	2161	av_extend (av, items - 1);
2058		2162
2059	for (i = 0; i < items; ++i)	2163	for (i = 0; i < items; ++i)
2060	av_push (av, SvREFCNT_inc_NN (arg [i]));	2164	av_push (av, SvREFCNT_inc_NN (arg [i]));
2061	}	2165	}
2062
2063	hv_store (coro_hv, "_status", sizeof ("_status") - 1, newRV_noinc ((SV *)av), 0);
2064	}	2166	}
2065		2167
2066	static void	2168	static void
2067	slf_init_terminate_cancel_common (pTHX_ struct CoroSLF *frame, HV *coro_hv)	2169	slf_init_terminate_cancel_common (pTHX_ struct CoroSLF *frame, HV *coro_hv)
2068	{	2170	{
…		…
2080	static void	2182	static void
2081	slf_init_terminate (pTHX_ struct CoroSLF *frame, CV *cv, SV **arg, int items)	2183	slf_init_terminate (pTHX_ struct CoroSLF *frame, CV *cv, SV **arg, int items)
2082	{	2184	{
2083	HV *coro_hv = (HV *)SvRV (coro_current);	2185	HV *coro_hv = (HV *)SvRV (coro_current);
2084		2186
2085	coro_set_status (aTHX_ coro_hv, arg, items);	2187	coro_set_status (aTHX_ SvSTATE ((SV *)coro_hv), arg, items);
2086	slf_init_terminate_cancel_common (aTHX_ frame, coro_hv);	2188	slf_init_terminate_cancel_common (aTHX_ frame, coro_hv);
2087	}	2189	}
2088		2190
2089	static void	2191	static void
2090	slf_init_cancel (pTHX_ struct CoroSLF *frame, CV *cv, SV **arg, int items)	2192	slf_init_cancel (pTHX_ struct CoroSLF *frame, CV *cv, SV **arg, int items)
…		…
2096	croak ("Coro::cancel called without coro object,");	2198	croak ("Coro::cancel called without coro object,");
2097		2199
2098	coro = SvSTATE (arg [0]);	2200	coro = SvSTATE (arg [0]);
2099	coro_hv = coro->hv;	2201	coro_hv = coro->hv;
2100		2202
2101	coro_set_status (aTHX_ coro_hv, arg + 1, items - 1);	2203	coro_set_status (aTHX_ coro, arg + 1, items - 1);
2102		2204
2103	if (expect_false (coro->flags & CF_NOCANCEL))	2205	if (ecb_expect_false (coro->flags & CF_NOCANCEL))
2104	{	2206	{
2105	/* coro currently busy cancelling something, so just notify it */	2207	/* coro currently busy cancelling something, so just notify it */
2106	coro->slf_frame.data = (void *)coro;	2208	coro->slf_frame.data = (void *)coro;
2107		2209
2108	frame->prepare = prepare_nop;	2210	frame->prepare = prepare_nop;
…		…
2123	* this is ugly, and hopefully fully worth the extra speed.	2225	* this is ugly, and hopefully fully worth the extra speed.
2124	* besides, I can't get the slow-but-safe version working...	2226	* besides, I can't get the slow-but-safe version working...
2125	*/	2227	*/
2126	slf_frame.data = 0;	2228	slf_frame.data = 0;
2127	self->flags |= CF_NOCANCEL;	2229	self->flags |= CF_NOCANCEL;
2128
2129	coro_state_destroy (aTHX_ coro);	2230	coro_state_destroy (aTHX_ coro);
2130	coro_call_on_destroy (aTHX_ coro);
2131
2132	self->flags &= ~CF_NOCANCEL;	2231	self->flags &= ~CF_NOCANCEL;
2133		2232
2134	if (slf_frame.data)	2233	if (slf_frame.data)
2135	{	2234	{
2136	/* while we were busy we have been cancelled, so terminate */	2235	/* while we were busy we have been cancelled, so terminate */
…		…
2161	if (coro->cctx)	2260	if (coro->cctx)
2162	croak ("coro inside C callback, unable to cancel at this time, caught");	2261	croak ("coro inside C callback, unable to cancel at this time, caught");
2163		2262
2164	if (coro->flags & CF_NEW)	2263	if (coro->flags & CF_NEW)
2165	{	2264	{
2166	coro_set_status (aTHX_ coro->hv, arg, items);	2265	coro_set_status (aTHX_ coro, arg, items);
2167	coro_state_destroy (aTHX_ coro);	2266	coro_state_destroy (aTHX_ coro);
2168	coro_call_on_destroy (aTHX_ coro);
2169	}	2267	}
2170	else	2268	else
2171	{	2269	{
2172	if (!coro->slf_frame.prepare)	2270	if (!coro->slf_frame.prepare)
2173	croak ("coro outside an SLF function, unable to cancel at this time, caught");	2271	croak ("coro outside an SLF function, unable to cancel at this time, caught");
2174		2272
2175	slf_destroy (aTHX_ coro);	2273	slf_destroy (aTHX_ coro);
2176		2274
2177	coro_set_status (aTHX_ coro->hv, arg, items);	2275	coro_set_status (aTHX_ coro, arg, items);
2178	coro->slf_frame.prepare = prepare_nop;	2276	coro->slf_frame.prepare = prepare_nop;
2179	coro->slf_frame.check = slf_check_safe_cancel;	2277	coro->slf_frame.check = slf_check_safe_cancel;
2180		2278
2181	api_ready (aTHX_ coro->hv);	2279	api_ready (aTHX_ (SV *)coro->hv);
2182	}	2280	}
2183		2281
2184	return 1;	2282	return 1;
2185	}	2283	}
2186		2284
…		…
2220	slf_init_pool_handler (pTHX_ struct CoroSLF *frame, CV *cv, SV **arg, int items)	2318	slf_init_pool_handler (pTHX_ struct CoroSLF *frame, CV *cv, SV **arg, int items)
2221	{	2319	{
2222	HV *hv = (HV *)SvRV (coro_current);	2320	HV *hv = (HV *)SvRV (coro_current);
2223	struct coro *coro = SvSTATE_hv ((SV *)hv);	2321	struct coro *coro = SvSTATE_hv ((SV *)hv);
2224		2322
2225	if (expect_true (coro->saved_deffh))	2323	if (ecb_expect_true (coro->saved_deffh))
2226	{	2324	{
2227	/* subsequent iteration */	2325	/* subsequent iteration */
2228	SvREFCNT_dec ((SV *)PL_defoutgv); PL_defoutgv = (GV *)coro->saved_deffh;	2326	SvREFCNT_dec ((SV *)PL_defoutgv); PL_defoutgv = (GV *)coro->saved_deffh;
2229	coro->saved_deffh = 0;	2327	coro->saved_deffh = 0;
2230		2328
…		…
2471	static void	2569	static void
2472	slf_destroy (pTHX_ struct coro *coro)	2570	slf_destroy (pTHX_ struct coro *coro)
2473	{	2571	{
2474	/* this callback is reserved for slf functions needing to do cleanup */	2572	/* this callback is reserved for slf functions needing to do cleanup */
2475	if (coro->slf_frame.destroy && coro->slf_frame.prepare && !PL_dirty)	2573	if (coro->slf_frame.destroy && coro->slf_frame.prepare && !PL_dirty)
2476	coro->slf_frame.destroy (aTHX_ coro);	2574	coro->slf_frame.destroy (aTHX_ &coro->slf_frame);
2477		2575
2478	/*	2576	/*
2479	* The on_destroy above most likely is from an SLF call.	2577	* The on_destroy above most likely is from an SLF call.
2480	* Since by definition the SLF call will not finish when we destroy	2578	* Since by definition the SLF call will not finish when we destroy
2481	* the coro, we will have to force-finish it here, otherwise	2579	* the coro, we will have to force-finish it here, otherwise
…		…
2496	I32 checkmark; /* mark SP to see how many elements check has pushed */	2594	I32 checkmark; /* mark SP to see how many elements check has pushed */
2497		2595
2498	/* set up the slf frame, unless it has already been set-up */	2596	/* set up the slf frame, unless it has already been set-up */
2499	/* the latter happens when a new coro has been started */	2597	/* the latter happens when a new coro has been started */
2500	/* or when a new cctx was attached to an existing coroutine */	2598	/* or when a new cctx was attached to an existing coroutine */
2501	if (expect_true (!slf_frame.prepare))	2599	if (ecb_expect_true (!slf_frame.prepare))
2502	{	2600	{
2503	/* first iteration */	2601	/* first iteration */
2504	dSP;	2602	dSP;
2505	SV **arg = PL_stack_base + TOPMARK + 1;	2603	SV **arg = PL_stack_base + TOPMARK + 1;
2506	int items = SP - arg; /* args without function object */	2604	int items = SP - arg; /* args without function object */
…		…
2547	while (slf_frame.check (aTHX_ &slf_frame));	2645	while (slf_frame.check (aTHX_ &slf_frame));
2548		2646
2549	slf_frame.prepare = 0; /* invalidate the frame, we are done processing it */	2647	slf_frame.prepare = 0; /* invalidate the frame, we are done processing it */
2550		2648
2551	/* exception handling */	2649	/* exception handling */
2552	if (expect_false (CORO_THROW))	2650	if (ecb_expect_false (CORO_THROW))
2553	{	2651	{
2554	SV *exception = sv_2mortal (CORO_THROW);	2652	SV *exception = sv_2mortal (CORO_THROW);
2555		2653
2556	CORO_THROW = 0;	2654	CORO_THROW = 0;
2557	sv_setsv (ERRSV, exception);	2655	sv_setsv (ERRSV, exception);
2558	croak (0);	2656	croak (0);
2559	}	2657	}
2560		2658
2561	/* return value handling - mostly like entersub */	2659	/* return value handling - mostly like entersub */
2562	/* make sure we put something on the stack in scalar context */	2660	/* make sure we put something on the stack in scalar context */
2563	if (GIMME_V == G_SCALAR)	2661	if (GIMME_V == G_SCALAR
		2662	&& ecb_expect_false (PL_stack_sp != PL_stack_base + checkmark + 1))
2564	{	2663	{
2565	dSP;	2664	dSP;
2566	SV **bot = PL_stack_base + checkmark;	2665	SV **bot = PL_stack_base + checkmark;
2567		2666
2568	if (sp == bot) /* too few, push undef */	2667	if (sp == bot) /* too few, push undef */
2569	bot [1] = &PL_sv_undef;	2668	bot [1] = &PL_sv_undef;
2570	else if (sp != bot + 1) /* too many, take last one */	2669	else /* too many, take last one */
2571	bot [1] = *sp;	2670	bot [1] = *sp;
2572		2671
2573	SP = bot + 1;	2672	SP = bot + 1;
2574		2673
2575	PUTBACK;	2674	PUTBACK;
…		…
2682	{	2781	{
2683	PerlIOBuf base;	2782	PerlIOBuf base;
2684	NV next, every;	2783	NV next, every;
2685	} PerlIOCede;	2784	} PerlIOCede;
2686		2785
2687	static IV	2786	static IV ecb_cold
2688	PerlIOCede_pushed (pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab)	2787	PerlIOCede_pushed (pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab)
2689	{	2788	{
2690	PerlIOCede *self = PerlIOSelf (f, PerlIOCede);	2789	PerlIOCede *self = PerlIOSelf (f, PerlIOCede);
2691		2790
2692	self->every = SvCUR (arg) ? SvNV (arg) : 0.01;	2791	self->every = SvCUR (arg) ? SvNV (arg) : 0.01;
2693	self->next = nvtime () + self->every;	2792	self->next = nvtime () + self->every;
2694		2793
2695	return PerlIOBuf_pushed (aTHX_ f, mode, Nullsv, tab);	2794	return PerlIOBuf_pushed (aTHX_ f, mode, Nullsv, tab);
2696	}	2795	}
2697		2796
2698	static SV *	2797	static SV * ecb_cold
2699	PerlIOCede_getarg (pTHX_ PerlIO *f, CLONE_PARAMS *param, int flags)	2798	PerlIOCede_getarg (pTHX_ PerlIO *f, CLONE_PARAMS *param, int flags)
2700	{	2799	{
2701	PerlIOCede *self = PerlIOSelf (f, PerlIOCede);	2800	PerlIOCede *self = PerlIOSelf (f, PerlIOCede);
2702		2801
2703	return newSVnv (self->every);	2802	return newSVnv (self->every);
…		…
2815	SvREFCNT_dec (cb);	2914	SvREFCNT_dec (cb);
2816	}	2915	}
2817	}	2916	}
2818		2917
2819	static void	2918	static void
2820	coro_semaphore_destroy (pTHX_ struct coro *coro)	2919	coro_semaphore_destroy (pTHX_ struct CoroSLF *frame)
2821	{	2920	{
2822	/* call $sem->adjust (0) to possibly wake up some other waiters */	2921	/* call $sem->adjust (0) to possibly wake up some other waiters */
2823	coro_semaphore_adjust (aTHX_ (AV *)coro->slf_frame.data, 0);	2922	coro_semaphore_adjust (aTHX_ (AV *)frame->data, 0);
2824	}	2923	}
2825		2924
2826	static int	2925	static int
2827	slf_check_semaphore_down_or_wait (pTHX_ struct CoroSLF *frame, int acquire)	2926	slf_check_semaphore_down_or_wait (pTHX_ struct CoroSLF *frame, int acquire)
2828	{	2927	{
2829	AV *av = (AV *)frame->data;	2928	AV *av = (AV *)frame->data;
2830	SV *count_sv = AvARRAY (av)[0];	2929	SV *count_sv = AvARRAY (av)[0];
		2930	SV *coro_hv = SvRV (coro_current);
2831		2931
2832	/* if we are about to throw, don't actually acquire the lock, just throw */	2932	/* if we are about to throw, don't actually acquire the lock, just throw */
2833	if (CORO_THROW)	2933	if (CORO_THROW)
2834	return 0;	2934	return 0;
2835	else if (SvIVX (count_sv) > 0)	2935	else if (SvIVX (count_sv) > 0)
…		…
2847	{	2947	{
2848	int i;	2948	int i;
2849	/* if we were woken up but can't down, we look through the whole */	2949	/* if we were woken up but can't down, we look through the whole */
2850	/* waiters list and only add us if we aren't in there already */	2950	/* waiters list and only add us if we aren't in there already */
2851	/* this avoids some degenerate memory usage cases */	2951	/* this avoids some degenerate memory usage cases */
2852		2952	for (i = AvFILLp (av); i > 0; --i) // i > 0 is not an off-by-one bug
2853	for (i = 1; i <= AvFILLp (av); ++i)
2854	if (AvARRAY (av)[i] == SvRV (coro_current))	2953	if (AvARRAY (av)[i] == coro_hv)
2855	return 1;	2954	return 1;
2856		2955
2857	av_push (av, SvREFCNT_inc (SvRV (coro_current)));	2956	av_push (av, SvREFCNT_inc (coro_hv));
2858	return 1;	2957	return 1;
2859	}	2958	}
2860	}	2959	}
2861		2960
2862	static int	2961	static int
…		…
3115	dSP;	3214	dSP;
3116		3215
3117	static SV *prio_cv;	3216	static SV *prio_cv;
3118	static SV *prio_sv;	3217	static SV *prio_sv;
3119		3218
3120	if (expect_false (!prio_cv))	3219	if (ecb_expect_false (!prio_cv))
3121	{	3220	{
3122	prio_cv = (SV *)get_cv ("IO::AIO::aioreq_pri", 0);	3221	prio_cv = (SV *)get_cv ("IO::AIO::aioreq_pri", 0);
3123	prio_sv = newSViv (0);	3222	prio_sv = newSViv (0);
3124	}	3223	}
3125		3224
…		…
3231	}	3330	}
3232		3331
3233	return coro_sv;	3332	return coro_sv;
3234	}	3333	}
3235		3334
		3335	#ifndef __cplusplus
		3336	ecb_cold XS(boot_Coro__State);
		3337	#endif
		3338
		3339	#if CORO_JIT
		3340
		3341	static void ecb_noinline ecb_cold
		3342	pushav_3uv (pTHX_ UV a, UV b, UV c)
		3343	{
		3344	dSP;
		3345	AV *av = newAV ();
		3346
		3347	av_store (av, 2, newSVuv (c));
		3348	av_store (av, 1, newSVuv (b));
		3349	av_store (av, 0, newSVuv (a));
		3350
		3351	XPUSHs (sv_2mortal (newRV_noinc ((SV *)av)));
		3352
		3353	PUTBACK;
		3354	}
		3355
		3356	static void ecb_noinline ecb_cold
		3357	jit_init (pTHX)
		3358	{
		3359	dSP;
		3360	SV *load, *save;
		3361	char *map_base;
		3362	char *load_ptr, *save_ptr;
		3363	STRLEN load_len, save_len;
		3364	int count;
		3365
		3366	PUSHMARK (SP);
		3367	PUTBACK;
		3368	#define VARx(name,expr,type) pushav_3uv (aTHX_ (UV)&(expr), offsetof (perl_slots, name), sizeof (type));
		3369	# include "state.h"
		3370	#undef VARx
		3371	count = call_pv ("Coro::State::_jit", G_ARRAY);
		3372	SPAGAIN;
		3373
		3374	save = POPs; save_ptr = SvPVbyte (save, save_len);
		3375	load = POPs; load_ptr = SvPVbyte (load, load_len);
		3376
		3377	map_base = mmap (0, load_len + save_len + 16, PROT_EXEC | PROT_WRITE, MAP_PRIVATE | MAP_ANONYMOUS, -1, 0);
		3378
		3379	assert (("Coro: unable mmap jit code page, cannot continue.", map_base != (char *)MAP_FAILED));
		3380
		3381	load_perl_slots = (load_save_perl_slots_type)map_base;
		3382	memcpy (map_base, load_ptr, load_len);
		3383
		3384	map_base += (load_len + 15) & ~15;
		3385
		3386	save_perl_slots = (load_save_perl_slots_type)map_base;
		3387	memcpy (map_base, save_ptr, save_len);
		3388	}
		3389
		3390	#endif
		3391
3236	MODULE = Coro::State PACKAGE = Coro::State PREFIX = api_	3392	MODULE = Coro::State PACKAGE = Coro::State PREFIX = api_
3237		3393
3238	PROTOTYPES: DISABLE	3394	PROTOTYPES: DISABLE
3239		3395
3240	BOOT:	3396	BOOT:
…		…
3244	coro_thx = PERL_GET_CONTEXT;	3400	coro_thx = PERL_GET_CONTEXT;
3245	# endif	3401	# endif
3246	#endif	3402	#endif
3247	BOOT_PAGESIZE;	3403	BOOT_PAGESIZE;
3248		3404
		3405	/* perl defines these to check for existance first, but why it doesn't */
		3406	/* just create them one at init time is not clear to me, except for */
		3407	/* programs trying to delete them, but... */
		3408	/* anyway, we declare this as invalid and make sure they are initialised here */
		3409	DEFSV;
		3410	ERRSV;
		3411
3249	cctx_current = cctx_new_empty ();	3412	cctx_current = cctx_new_empty ();
3250		3413
3251	irsgv = gv_fetchpv ("/" , GV_ADD|GV_NOTQUAL, SVt_PV);	3414	irsgv = gv_fetchpv ("/" , GV_ADD|GV_NOTQUAL, SVt_PV);
3252	stdoutgv = gv_fetchpv ("STDOUT", GV_ADD|GV_NOTQUAL, SVt_PVIO);	3415	stdoutgv = gv_fetchpv ("STDOUT", GV_ADD|GV_NOTQUAL, SVt_PVIO);
3253		3416
…		…
3295	coroapi.prepare_cede_notself = prepare_cede_notself;	3458	coroapi.prepare_cede_notself = prepare_cede_notself;
3296		3459
3297	time_init (aTHX);	3460	time_init (aTHX);
3298		3461
3299	assert (("PRIO_NORMAL must be 0", !CORO_PRIO_NORMAL));	3462	assert (("PRIO_NORMAL must be 0", !CORO_PRIO_NORMAL));
		3463	#if CORO_JIT
		3464	PUTBACK;
		3465	require_pv ("Coro/jit-" CORO_JIT_TYPE ".pl");
		3466	jit_init (aTHX);
		3467	perl_eval_pv ("undef &Coro::State::_jit", 1);
		3468	SPAGAIN;
		3469	#endif
3300	}	3470	}
3301		3471
3302	SV *	3472	SV *
3303	new (SV *klass, ...)	3473	new (SV *klass, ...)
3304	ALIAS:	3474	ALIAS:
…		…
3446	PROTOTYPE: $	3616	PROTOTYPE: $
3447	ALIAS:	3617	ALIAS:
3448	is_ready = CF_READY	3618	is_ready = CF_READY
3449	is_running = CF_RUNNING	3619	is_running = CF_RUNNING
3450	is_new = CF_NEW	3620	is_new = CF_NEW
3451	is_destroyed = CF_DESTROYED	3621	is_destroyed = CF_ZOMBIE
		3622	is_zombie = CF_ZOMBIE
3452	is_suspended = CF_SUSPENDED	3623	is_suspended = CF_SUSPENDED
3453	CODE:	3624	CODE:
3454	RETVAL = boolSV (coro->flags & ix);	3625	RETVAL = boolSV (coro->flags & ix);
3455	OUTPUT:	3626	OUTPUT:
3456	RETVAL	3627	RETVAL
…		…
3551	times (Coro::State self)	3722	times (Coro::State self)
3552	PPCODE:	3723	PPCODE:
3553	{	3724	{
3554	struct coro *current = SvSTATE (coro_current);	3725	struct coro *current = SvSTATE (coro_current);
3555		3726
3556	if (expect_false (current == self))	3727	if (ecb_expect_false (current == self))
3557	{	3728	{
3558	coro_times_update ();	3729	coro_times_update ();
3559	coro_times_add (SvSTATE (coro_current));	3730	coro_times_add (SvSTATE (coro_current));
3560	}	3731	}
3561		3732
3562	EXTEND (SP, 2);	3733	EXTEND (SP, 2);
3563	PUSHs (sv_2mortal (newSVnv (self->t_real [0] + self->t_real [1] * 1e-9)));	3734	PUSHs (sv_2mortal (newSVnv (self->t_real [0] + self->t_real [1] * 1e-9)));
3564	PUSHs (sv_2mortal (newSVnv (self->t_cpu [0] + self->t_cpu [1] * 1e-9)));	3735	PUSHs (sv_2mortal (newSVnv (self->t_cpu [0] + self->t_cpu [1] * 1e-9)));
3565		3736
3566	if (expect_false (current == self))	3737	if (ecb_expect_false (current == self))
3567	coro_times_sub (SvSTATE (coro_current));	3738	coro_times_sub (SvSTATE (coro_current));
3568	}	3739	}
3569		3740
3570	void	3741	void
3571	swap_sv (Coro::State coro, SV *sv, SV *swapsv)	3742	swap_sv (Coro::State coro, SV *sv, SV *swapsv)
…		…
3644	void	3815	void
3645	_destroy (Coro::State coro)	3816	_destroy (Coro::State coro)
3646	CODE:	3817	CODE:
3647	/* used by the manager thread */	3818	/* used by the manager thread */
3648	coro_state_destroy (aTHX_ coro);	3819	coro_state_destroy (aTHX_ coro);
		3820
		3821	void
		3822	on_destroy (Coro::State coro, SV *cb)
		3823	CODE:
3649	coro_call_on_destroy (aTHX_ coro);	3824	coro_push_on_destroy (aTHX_ coro, newSVsv (cb));
		3825
		3826	void
		3827	join (...)
		3828	CODE:
		3829	CORO_EXECUTE_SLF_XS (slf_init_join);
3650		3830
3651	void	3831	void
3652	terminate (...)	3832	terminate (...)
3653	CODE:	3833	CODE:
3654	CORO_EXECUTE_SLF_XS (slf_init_terminate);	3834	CORO_EXECUTE_SLF_XS (slf_init_terminate);

Diff Legend

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