ViewVC Help

View File | Revision Log | Show Annotations | Download File

/cvs/Coro/Coro/State.xs

Comparing Coro/Coro/State.xs (file contents):
Revision 1.397 by root, Fri May 6 21:15:17 2011 UTC vs.
Revision 1.415 by root, Tue Aug 30 07:48:53 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
…		…
31	# define setjmp _setjmp /* deep magic */	33	# define setjmp _setjmp /* deep magic */
32	#else	34	#else
33	# include <inttypes.h> /* most portable stdint.h */	35	# include <inttypes.h> /* most portable stdint.h */
34	#endif	36	#endif
35		37
36	#ifdef HAVE_MMAP	38	#if HAVE_MMAP
37	# include <unistd.h>	39	# include <unistd.h>
38	# include <sys/mman.h>	40	# include <sys/mman.h>
39	# ifndef MAP_ANONYMOUS	41	# ifndef MAP_ANONYMOUS
40	# ifdef MAP_ANON	42	# ifdef MAP_ANON
41	# define MAP_ANONYMOUS MAP_ANON	43	# define MAP_ANONYMOUS MAP_ANON
…		…
61	#endif	63	#endif
62		64
63	/* the maximum number of idle cctx that will be pooled */	65	/* the maximum number of idle cctx that will be pooled */
64	static int cctx_max_idle = 4;	66	static int cctx_max_idle = 4;
65		67
		68	#if defined(DEBUGGING) && PERL_VERSION_ATLEAST(5,12,0)
		69	# define HAS_SCOPESTACK_NAME 1
		70	#endif
		71
66	#if !__i386 && !__x86_64 && !__powerpc && !__m68k && !__alpha && !__mips && !__sparc64	72	#if !__i386 && !__x86_64 && !__powerpc && !__m68k && !__alpha && !__mips && !__sparc64
67	# undef CORO_STACKGUARD	73	# undef CORO_STACKGUARD
68	#endif	74	#endif
69		75
70	#ifndef CORO_STACKGUARD	76	#ifndef CORO_STACKGUARD
…		…
86	# define STACKLEVEL ((void *)&stacklevel)	92	# define STACKLEVEL ((void *)&stacklevel)
87	#endif	93	#endif
88		94
89	#define IN_DESTRUCT PL_dirty	95	#define IN_DESTRUCT PL_dirty
90		96
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"	97	#include "CoroAPI.h"
107	#define GCoroAPI (&coroapi) /* very sneaky */	98	#define GCoroAPI (&coroapi) /* very sneaky */
108		99
109	#ifdef USE_ITHREADS	100	#ifdef USE_ITHREADS
110	# if CORO_PTHREAD	101	# if CORO_PTHREAD
111	static void *coro_thx;	102	static void *coro_thx;
112	# endif	103	# endif
113	#endif	104	#endif
		105
		106	/* used in state.h */
		107	#define VAR(name,type) VARx(name, PL_ ## name, type)
114		108
115	#ifdef __linux	109	#ifdef __linux
116	# include <time.h> /* for timespec */	110	# include <time.h> /* for timespec */
117	# include <syscall.h> /* for SYS_* */	111	# include <syscall.h> /* for SYS_* */
118	# ifdef SYS_clock_gettime	112	# ifdef SYS_clock_gettime
…		…
166	static char times_valid;	160	static char times_valid;
167		161
168	static struct coro_cctx *cctx_first;	162	static struct coro_cctx *cctx_first;
169	static int cctx_count, cctx_idle;	163	static int cctx_count, cctx_idle;
170		164
171	enum {	165	enum
		166	{
172	CC_MAPPED = 0x01,	167	CC_MAPPED = 0x01,
173	CC_NOREUSE = 0x02, /* throw this away after tracing */	168	CC_NOREUSE = 0x02, /* throw this away after tracing */
174	CC_TRACE = 0x04,	169	CC_TRACE = 0x04,
175	CC_TRACE_SUB = 0x08, /* trace sub calls */	170	CC_TRACE_SUB = 0x08, /* trace sub calls */
176	CC_TRACE_LINE = 0x10, /* trace each statement */	171	CC_TRACE_LINE = 0x10, /* trace each statement */
…		…
201		196
202	static coro_cctx *cctx_current; /* the currently running cctx */	197	static coro_cctx *cctx_current; /* the currently running cctx */
203		198
204	/*****************************************************************************/	199	/*****************************************************************************/
205		200
		201	static MGVTBL coro_state_vtbl;
		202
206	enum {	203	enum
		204	{
207	CF_RUNNING = 0x0001, /* coroutine is running */	205	CF_RUNNING = 0x0001, /* coroutine is running */
208	CF_READY = 0x0002, /* coroutine is ready */	206	CF_READY = 0x0002, /* coroutine is ready */
209	CF_NEW = 0x0004, /* has never been switched to */	207	CF_NEW = 0x0004, /* has never been switched to */
210	CF_DESTROYED = 0x0008, /* coroutine data has been freed */	208	CF_ZOMBIE = 0x0008, /* coroutine data has been freed */
211	CF_SUSPENDED = 0x0010, /* coroutine can't be scheduled */	209	CF_SUSPENDED = 0x0010, /* coroutine can't be scheduled */
212	CF_NOCANCEL = 0x0020, /* cannot cancel, set slf_frame.data to 1 (hackish) */	210	CF_NOCANCEL = 0x0020, /* cannot cancel, set slf_frame.data to 1 (hackish) */
213	};	211	};
214		212
215	/* the structure where most of the perl state is stored, overlaid on the cxstack */	213	/* the structure where most of the perl state is stored, overlaid on the cxstack */
216	typedef struct	214	typedef struct
217	{	215	{
218	SV *defsv;
219	AV *defav;
220	SV *errsv;
221	SV *irsgv;
222	HV *hinthv;
223	#define VAR(name,type) type name;	216	#define VARx(name,expr,type) type name;
224	# include "state.h"	217	# include "state.h"
225	#undef VAR	218	#undef VARx
226	} perl_slots;	219	} perl_slots;
227		220
		221	/* how many context stack entries do we need for perl_slots */
228	#define SLOT_COUNT ((sizeof (perl_slots) + sizeof (PERL_CONTEXT) - 1) / sizeof (PERL_CONTEXT))	222	#define SLOT_COUNT ((sizeof (perl_slots) + sizeof (PERL_CONTEXT) - 1) / sizeof (PERL_CONTEXT))
229		223
230	/* this is a structure representing a perl-level coroutine */	224	/* this is a structure representing a perl-level coroutine */
231	struct coro {	225	struct coro
		226	{
232	/* the C coroutine allocated to this perl coroutine, if any */	227	/* the C coroutine allocated to this perl coroutine, if any */
233	coro_cctx *cctx;	228	coro_cctx *cctx;
234		229
235	/* ready queue */	230	/* ready queue */
236	struct coro *next_ready;	231	struct coro *next_ready;
…		…
238	/* state data */	233	/* state data */
239	struct CoroSLF slf_frame; /* saved slf frame */	234	struct CoroSLF slf_frame; /* saved slf frame */
240	AV *mainstack;	235	AV *mainstack;
241	perl_slots *slot; /* basically the saved sp */	236	perl_slots *slot; /* basically the saved sp */
242		237
243	CV *startcv; /* the CV to execute */	238	CV *startcv; /* the CV to execute */
244	AV *args; /* data associated with this coroutine (initial args) */	239	AV *args; /* data associated with this coroutine (initial args) */
245	int refcnt; /* coroutines are refcounted, yes */
246	int flags; /* CF_ flags */	240	int flags; /* CF_ flags */
247	HV *hv; /* the perl hash associated with this coro, if any */	241	HV *hv; /* the perl hash associated with this coro, if any */
248		242
249	/* statistics */	243	/* statistics */
250	int usecount; /* number of transfers to this coro */	244	int usecount; /* number of transfers to this coro */
251		245
252	/* coro process data */	246	/* coro process data */
253	int prio;	247	int prio;
254	SV *except; /* exception to be thrown */	248	SV *except; /* exception to be thrown */
255	SV *rouse_cb;	249	SV *rouse_cb; /* last rouse callback */
		250	AV *on_destroy; /* callbacks or coros to notify on destroy */
		251	AV *status; /* the exit status list */
256		252
257	/* async_pool */	253	/* async_pool */
258	SV *saved_deffh;	254	SV *saved_deffh;
259	SV *invoke_cb;	255	SV *invoke_cb;
260	AV *invoke_av;	256	AV *invoke_av;
…		…
296	static struct coro *coro_ready [CORO_PRIO_MAX - CORO_PRIO_MIN + 1][2]; /* head|tail */	292	static struct coro *coro_ready [CORO_PRIO_MAX - CORO_PRIO_MIN + 1][2]; /* head|tail */
297	static CV *cv_coro_run;	293	static CV *cv_coro_run;
298	static struct coro *coro_first;	294	static struct coro *coro_first;
299	#define coro_nready coroapi.nready	295	#define coro_nready coroapi.nready
300		296
		297	/** JIT *********************************************************************/
		298
		299	#if CORO_JIT
		300	/* APPLE doesn't have HAVE_MMAP though */
		301	#define CORO_JIT_UNIXY (__linux || __FreeBSD__ || __OpenBSD__ || __NetBSD__ || __solaris || __APPLE__)
		302	#ifndef CORO_JIT_TYPE
		303	#if __x86_64 && CORO_JIT_UNIXY
		304	#define CORO_JIT_TYPE "amd64-unix"
		305	#elif __i386 && CORO_JIT_UNIXY
		306	#define CORO_JIT_TYPE "x86-unix"
		307	#endif
		308	#endif
		309	#endif
		310
		311	#if !defined(CORO_JIT_TYPE) || !HAVE_MMAP
		312	#undef CORO_JIT
		313	#endif
		314
		315	#if CORO_JIT
		316	typedef void (*load_save_perl_slots_type)(perl_slots *);
		317	static load_save_perl_slots_type load_perl_slots, save_perl_slots;
		318	#endif
		319
301	/** Coro::Select ************************************************************/	320	/** Coro::Select ************************************************************/
302		321
303	static OP *(*coro_old_pp_sselect) (pTHX);	322	static OP *(*coro_old_pp_sselect) (pTHX);
304	static SV *coro_select_select;	323	static SV *coro_select_select;
305		324
…		…
320		339
321	/** time stuff **************************************************************/	340	/** time stuff **************************************************************/
322		341
323	#ifdef HAS_GETTIMEOFDAY	342	#ifdef HAS_GETTIMEOFDAY
324		343
325	static void	344	ecb_inline void
326	coro_u2time (pTHX_ UV ret[2])	345	coro_u2time (pTHX_ UV ret[2])
327	{	346	{
328	struct timeval tv;	347	struct timeval tv;
329	gettimeofday (&tv, 0);	348	gettimeofday (&tv, 0);
330		349
331	ret [0] = tv.tv_sec;	350	ret [0] = tv.tv_sec;
332	ret [1] = tv.tv_usec;	351	ret [1] = tv.tv_usec;
333	}	352	}
334		353
335	static double	354	ecb_inline double
336	coro_nvtime ()	355	coro_nvtime (void)
337	{	356	{
338	struct timeval tv;	357	struct timeval tv;
339	gettimeofday (&tv, 0);	358	gettimeofday (&tv, 0);
340		359
341	return tv.tv_sec + tv.tv_usec * 1e-6;	360	return tv.tv_sec + tv.tv_usec * 1e-6;
342	}	361	}
343		362
344	static void	363	ecb_inline void
345	time_init (pTHX)	364	time_init (pTHX)
346	{	365	{
347	nvtime = coro_nvtime;	366	nvtime = coro_nvtime;
348	u2time = coro_u2time;	367	u2time = coro_u2time;
349	}	368	}
350		369
351	#else	370	#else
352		371
353	static void	372	ecb_inline void
354	time_init (pTHX)	373	time_init (pTHX)
355	{	374	{
356	SV **svp;	375	SV **svp;
357		376
358	require_pv ("Time/HiRes.pm");	377	require_pv ("Time/HiRes.pm");
…		…
370		389
371	#endif	390	#endif
372		391
373	/** lowlevel stuff **********************************************************/	392	/** lowlevel stuff **********************************************************/
374		393
375	static SV *	394	static SV * ecb_noinline
376	coro_get_sv (pTHX_ const char *name, int create)	395	coro_get_sv (pTHX_ const char *name, int create)
377	{	396	{
378	#if PERL_VERSION_ATLEAST (5,10,0)	397	#if PERL_VERSION_ATLEAST (5,10,0)
379	/* 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 */
380	get_sv (name, create);	399	get_sv (name, create);
381	#endif	400	#endif
382	return get_sv (name, create);	401	return get_sv (name, create);
383	}	402	}
384		403
385	static AV *	404	static AV * ecb_noinline
386	coro_get_av (pTHX_ const char *name, int create)	405	coro_get_av (pTHX_ const char *name, int create)
387	{	406	{
388	#if PERL_VERSION_ATLEAST (5,10,0)	407	#if PERL_VERSION_ATLEAST (5,10,0)
389	/* 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 */
390	get_av (name, create);	409	get_av (name, create);
391	#endif	410	#endif
392	return get_av (name, create);	411	return get_av (name, create);
393	}	412	}
394		413
395	static HV *	414	static HV * ecb_noinline
396	coro_get_hv (pTHX_ const char *name, int create)	415	coro_get_hv (pTHX_ const char *name, int create)
397	{	416	{
398	#if PERL_VERSION_ATLEAST (5,10,0)	417	#if PERL_VERSION_ATLEAST (5,10,0)
399	/* silence stupid and wrong 5.10 warning that I am unable to switch off */	418	/* silence stupid and wrong 5.10 warning that I am unable to switch off */
400	get_hv (name, create);	419	get_hv (name, create);
401	#endif	420	#endif
402	return get_hv (name, create);	421	return get_hv (name, create);
403	}	422	}
404		423
405	INLINE void	424	ecb_inline void
406	coro_times_update ()	425	coro_times_update (void)
407	{	426	{
408	#ifdef coro_clock_gettime	427	#ifdef coro_clock_gettime
409	struct timespec ts;	428	struct timespec ts;
410		429
411	ts.tv_sec = ts.tv_nsec = 0;	430	ts.tv_sec = ts.tv_nsec = 0;
…		…
423	time_real [0] = tv [0];	442	time_real [0] = tv [0];
424	time_real [1] = tv [1] * 1000;	443	time_real [1] = tv [1] * 1000;
425	#endif	444	#endif
426	}	445	}
427		446
428	INLINE void	447	ecb_inline void
429	coro_times_add (struct coro *c)	448	coro_times_add (struct coro *c)
430	{	449	{
431	c->t_real [1] += time_real [1];	450	c->t_real [1] += time_real [1];
432	if (c->t_real [1] > 1000000000) { c->t_real [1] -= 1000000000; ++c->t_real [0]; }	451	if (c->t_real [1] > 1000000000) { c->t_real [1] -= 1000000000; ++c->t_real [0]; }
433	c->t_real [0] += time_real [0];	452	c->t_real [0] += time_real [0];
…		…
435	c->t_cpu [1] += time_cpu [1];	454	c->t_cpu [1] += time_cpu [1];
436	if (c->t_cpu [1] > 1000000000) { c->t_cpu [1] -= 1000000000; ++c->t_cpu [0]; }	455	if (c->t_cpu [1] > 1000000000) { c->t_cpu [1] -= 1000000000; ++c->t_cpu [0]; }
437	c->t_cpu [0] += time_cpu [0];	456	c->t_cpu [0] += time_cpu [0];
438	}	457	}
439		458
440	INLINE void	459	ecb_inline void
441	coro_times_sub (struct coro *c)	460	coro_times_sub (struct coro *c)
442	{	461	{
443	if (c->t_real [1] < time_real [1]) { c->t_real [1] += 1000000000; --c->t_real [0]; }	462	if (c->t_real [1] < time_real [1]) { c->t_real [1] += 1000000000; --c->t_real [0]; }
444	c->t_real [1] -= time_real [1];	463	c->t_real [1] -= time_real [1];
445	c->t_real [0] -= time_real [0];	464	c->t_real [0] -= time_real [0];
…		…
453	/* magic glue */	472	/* magic glue */
454		473
455	#define CORO_MAGIC_type_cv 26	474	#define CORO_MAGIC_type_cv 26
456	#define CORO_MAGIC_type_state PERL_MAGIC_ext	475	#define CORO_MAGIC_type_state PERL_MAGIC_ext
457		476
458	#define CORO_MAGIC_NN(sv, type) \	477	#define CORO_MAGIC_NN(sv, type) \
459	(expect_true (SvMAGIC (sv)->mg_type == type) \	478	(ecb_expect_true (SvMAGIC (sv)->mg_type == type) \
460	? SvMAGIC (sv) \	479	? SvMAGIC (sv) \
461	: mg_find (sv, type))	480	: mg_find (sv, type))
462		481
463	#define CORO_MAGIC(sv, type) \	482	#define CORO_MAGIC(sv, type) \
464	(expect_true (SvMAGIC (sv)) \	483	(ecb_expect_true (SvMAGIC (sv)) \
465	? CORO_MAGIC_NN (sv, type) \	484	? CORO_MAGIC_NN (sv, type) \
466	: 0)	485	: 0)
467		486
468	#define CORO_MAGIC_cv(cv) CORO_MAGIC (((SV *)(cv)), CORO_MAGIC_type_cv)	487	#define CORO_MAGIC_cv(cv) CORO_MAGIC (((SV *)(cv)), CORO_MAGIC_type_cv)
469	#define CORO_MAGIC_state(sv) CORO_MAGIC_NN (((SV *)(sv)), CORO_MAGIC_type_state)	488	#define CORO_MAGIC_state(sv) CORO_MAGIC_NN (((SV *)(sv)), CORO_MAGIC_type_state)
470		489
471	INLINE struct coro *	490	ecb_inline MAGIC *
		491	SvSTATEhv_p (pTHX_ SV *coro)
		492	{
		493	MAGIC *mg;
		494
		495	if (ecb_expect_true (
		496	SvTYPE (coro) == SVt_PVHV
		497	&& (mg = CORO_MAGIC_state (coro))
		498	&& mg->mg_virtual == &coro_state_vtbl
		499	))
		500	return mg;
		501
		502	return 0;
		503	}
		504
		505	ecb_inline struct coro *
472	SvSTATE_ (pTHX_ SV *coro)	506	SvSTATE_ (pTHX_ SV *coro)
473	{	507	{
474	HV *stash;
475	MAGIC *mg;	508	MAGIC *mg;
476		509
477	if (SvROK (coro))	510	if (SvROK (coro))
478	coro = SvRV (coro);	511	coro = SvRV (coro);
479		512
480	if (expect_false (SvTYPE (coro) != SVt_PVHV))	513	mg = SvSTATEhv_p (aTHX_ coro);
		514	if (!mg)
481	croak ("Coro::State object required");	515	croak ("Coro::State object required");
482		516
483	stash = SvSTASH (coro);
484	if (expect_false (stash != coro_stash && stash != coro_state_stash))
485	{
486	/* very slow, but rare, check */
487	if (!sv_derived_from (sv_2mortal (newRV_inc (coro)), "Coro::State"))
488	croak ("Coro::State object required");
489	}
490
491	mg = CORO_MAGIC_state (coro);
492	return (struct coro *)mg->mg_ptr;	517	return (struct coro *)mg->mg_ptr;
493	}	518	}
494		519
495	#define SvSTATE(sv) SvSTATE_ (aTHX_ (sv))	520	#define SvSTATE(sv) SvSTATE_ (aTHX_ (sv))
496		521
…		…
499	#define SvSTATE_current SvSTATE_hv (SvRV (coro_current))	524	#define SvSTATE_current SvSTATE_hv (SvRV (coro_current))
500		525
501	/*****************************************************************************/	526	/*****************************************************************************/
502	/* padlist management and caching */	527	/* padlist management and caching */
503		528
504	static AV *	529	ecb_inline AV *
505	coro_derive_padlist (pTHX_ CV *cv)	530	coro_derive_padlist (pTHX_ CV *cv)
506	{	531	{
507	AV *padlist = CvPADLIST (cv);	532	AV *padlist = CvPADLIST (cv);
508	AV *newpadlist, *newpad;	533	AV *newpadlist, *newpad;
509		534
…		…
521	av_store (newpadlist, 1, (SV *)newpad);	546	av_store (newpadlist, 1, (SV *)newpad);
522		547
523	return newpadlist;	548	return newpadlist;
524	}	549	}
525		550
526	static void	551	ecb_inline void
527	free_padlist (pTHX_ AV *padlist)	552	free_padlist (pTHX_ AV *padlist)
528	{	553	{
529	/* may be during global destruction */	554	/* may be during global destruction */
530	if (!IN_DESTRUCT)	555	if (!IN_DESTRUCT)
531	{	556	{
…		…
574	0, 0, 0, 0,	599	0, 0, 0, 0,
575	coro_cv_free	600	coro_cv_free
576	};	601	};
577		602
578	/* the next two functions merely cache the padlists */	603	/* the next two functions merely cache the padlists */
579	static void	604	ecb_inline void
580	get_padlist (pTHX_ CV *cv)	605	get_padlist (pTHX_ CV *cv)
581	{	606	{
582	MAGIC *mg = CORO_MAGIC_cv (cv);	607	MAGIC *mg = CORO_MAGIC_cv (cv);
583	AV *av;	608	AV *av;
584		609
585	if (expect_true (mg && AvFILLp ((av = (AV *)mg->mg_obj)) >= 0))	610	if (ecb_expect_true (mg && AvFILLp ((av = (AV *)mg->mg_obj)) >= 0))
586	CvPADLIST (cv) = (AV *)AvARRAY (av)[AvFILLp (av)--];	611	CvPADLIST (cv) = (AV *)AvARRAY (av)[AvFILLp (av)--];
587	else	612	else
588	{	613	{
589	#if CORO_PREFER_PERL_FUNCTIONS	614	#if CORO_PREFER_PERL_FUNCTIONS
590	/* this is probably cleaner? but also slower! */	615	/* this is probably cleaner? but also slower! */
…		…
597	CvPADLIST (cv) = coro_derive_padlist (aTHX_ cv);	622	CvPADLIST (cv) = coro_derive_padlist (aTHX_ cv);
598	#endif	623	#endif
599	}	624	}
600	}	625	}
601		626
602	static void	627	ecb_inline void
603	put_padlist (pTHX_ CV *cv)	628	put_padlist (pTHX_ CV *cv)
604	{	629	{
605	MAGIC *mg = CORO_MAGIC_cv (cv);	630	MAGIC *mg = CORO_MAGIC_cv (cv);
606	AV *av;	631	AV *av;
607		632
608	if (expect_false (!mg))	633	if (ecb_expect_false (!mg))
609	mg = sv_magicext ((SV *)cv, (SV *)newAV (), CORO_MAGIC_type_cv, &coro_cv_vtbl, 0, 0);	634	mg = sv_magicext ((SV *)cv, (SV *)newAV (), CORO_MAGIC_type_cv, &coro_cv_vtbl, 0, 0);
610		635
611	av = (AV *)mg->mg_obj;	636	av = (AV *)mg->mg_obj;
612		637
613	if (expect_false (AvFILLp (av) >= AvMAX (av)))	638	if (ecb_expect_false (AvFILLp (av) >= AvMAX (av)))
614	av_extend (av, AvFILLp (av) + 1);	639	av_extend (av, AvFILLp (av) + 1);
615		640
616	AvARRAY (av)[++AvFILLp (av)] = (SV *)CvPADLIST (cv);	641	AvARRAY (av)[++AvFILLp (av)] = (SV *)CvPADLIST (cv);
617	}	642	}
618		643
…		…
663	}	688	}
664	#endif	689	#endif
665	}	690	}
666	}	691	}
667		692
668	#define SWAP_SVS(coro) \	693	#define SWAP_SVS(coro) \
669	if (expect_false ((coro)->swap_sv)) \	694	if (ecb_expect_false ((coro)->swap_sv)) \
670	swap_svs (aTHX_ (coro))	695	swap_svs (aTHX_ (coro))
671		696
672	static void	697	static void
673	on_enterleave_call (pTHX_ SV *cb);	698	on_enterleave_call (pTHX_ SV *cb);
674		699
…		…
678	perl_slots *slot = c->slot;	703	perl_slots *slot = c->slot;
679	c->slot = 0;	704	c->slot = 0;
680		705
681	PL_mainstack = c->mainstack;	706	PL_mainstack = c->mainstack;
682		707
683	GvSV (PL_defgv) = slot->defsv;	708	#if CORO_JIT
684	GvAV (PL_defgv) = slot->defav;	709	load_perl_slots (slot);
685	GvSV (PL_errgv) = slot->errsv;	710	#else
686	GvSV (irsgv) = slot->irsgv;
687	GvHV (PL_hintgv) = slot->hinthv;
688
689	#define VAR(name,type) PL_ ## name = slot->name;	711	#define VARx(name,expr,type) expr = slot->name;
690	# include "state.h"	712	# include "state.h"
691	#undef VAR	713	#undef VARx
		714	#endif
692		715
693	{	716	{
694	dSP;	717	dSP;
695		718
696	CV *cv;	719	CV *cv;
697		720
698	/* now do the ugly restore mess */	721	/* now do the ugly restore mess */
699	while (expect_true (cv = (CV *)POPs))	722	while (ecb_expect_true (cv = (CV *)POPs))
700	{	723	{
701	put_padlist (aTHX_ cv); /* mark this padlist as available */	724	put_padlist (aTHX_ cv); /* mark this padlist as available */
702	CvDEPTH (cv) = PTR2IV (POPs);	725	CvDEPTH (cv) = PTR2IV (POPs);
703	CvPADLIST (cv) = (AV *)POPs;	726	CvPADLIST (cv) = (AV *)POPs;
704	}	727	}
…		…
707	}	730	}
708		731
709	slf_frame = c->slf_frame;	732	slf_frame = c->slf_frame;
710	CORO_THROW = c->except;	733	CORO_THROW = c->except;
711		734
712	if (expect_false (enable_times))	735	if (ecb_expect_false (enable_times))
713	{	736	{
714	if (expect_false (!times_valid))	737	if (ecb_expect_false (!times_valid))
715	coro_times_update ();	738	coro_times_update ();
716		739
717	coro_times_sub (c);	740	coro_times_sub (c);
718	}	741	}
719		742
720	if (expect_false (c->on_enter))	743	if (ecb_expect_false (c->on_enter))
721	{	744	{
722	int i;	745	int i;
723		746
724	for (i = 0; i <= AvFILLp (c->on_enter); ++i)	747	for (i = 0; i <= AvFILLp (c->on_enter); ++i)
725	on_enterleave_call (aTHX_ AvARRAY (c->on_enter)[i]);	748	on_enterleave_call (aTHX_ AvARRAY (c->on_enter)[i]);
…		…
731	static void	754	static void
732	save_perl (pTHX_ Coro__State c)	755	save_perl (pTHX_ Coro__State c)
733	{	756	{
734	SWAP_SVS (c);	757	SWAP_SVS (c);
735		758
736	if (expect_false (c->on_leave))	759	if (ecb_expect_false (c->on_leave))
737	{	760	{
738	int i;	761	int i;
739		762
740	for (i = AvFILLp (c->on_leave); i >= 0; --i)	763	for (i = AvFILLp (c->on_leave); i >= 0; --i)
741	on_enterleave_call (aTHX_ AvARRAY (c->on_leave)[i]);	764	on_enterleave_call (aTHX_ AvARRAY (c->on_leave)[i]);
742	}	765	}
743		766
744	times_valid = 0;	767	times_valid = 0;
745		768
746	if (expect_false (enable_times))	769	if (ecb_expect_false (enable_times))
747	{	770	{
748	coro_times_update (); times_valid = 1;	771	coro_times_update (); times_valid = 1;
749	coro_times_add (c);	772	coro_times_add (c);
750	}	773	}
751		774
…		…
765		788
766	XPUSHs (Nullsv);	789	XPUSHs (Nullsv);
767	/* this loop was inspired by pp_caller */	790	/* this loop was inspired by pp_caller */
768	for (;;)	791	for (;;)
769	{	792	{
770	while (expect_true (cxix >= 0))	793	while (ecb_expect_true (cxix >= 0))
771	{	794	{
772	PERL_CONTEXT *cx = &ccstk[cxix--];	795	PERL_CONTEXT *cx = &ccstk[cxix--];
773		796
774	if (expect_true (CxTYPE (cx) == CXt_SUB) || expect_false (CxTYPE (cx) == CXt_FORMAT))	797	if (ecb_expect_true (CxTYPE (cx) == CXt_SUB) || ecb_expect_false (CxTYPE (cx) == CXt_FORMAT))
775	{	798	{
776	CV *cv = cx->blk_sub.cv;	799	CV *cv = cx->blk_sub.cv;
777		800
778	if (expect_true (CvDEPTH (cv)))	801	if (ecb_expect_true (CvDEPTH (cv)))
779	{	802	{
780	EXTEND (SP, 3);	803	EXTEND (SP, 3);
781	PUSHs ((SV *)CvPADLIST (cv));	804	PUSHs ((SV *)CvPADLIST (cv));
782	PUSHs (INT2PTR (SV *, (IV)CvDEPTH (cv)));	805	PUSHs (INT2PTR (SV *, (IV)CvDEPTH (cv)));
783	PUSHs ((SV *)cv);	806	PUSHs ((SV *)cv);
…		…
786	get_padlist (aTHX_ cv);	809	get_padlist (aTHX_ cv);
787	}	810	}
788	}	811	}
789	}	812	}
790		813
791	if (expect_true (top_si->si_type == PERLSI_MAIN))	814	if (ecb_expect_true (top_si->si_type == PERLSI_MAIN))
792	break;	815	break;
793		816
794	top_si = top_si->si_prev;	817	top_si = top_si->si_prev;
795	ccstk = top_si->si_cxstack;	818	ccstk = top_si->si_cxstack;
796	cxix = top_si->si_cxix;	819	cxix = top_si->si_cxix;
…		…
798		821
799	PUTBACK;	822	PUTBACK;
800	}	823	}
801		824
802	/* allocate some space on the context stack for our purposes */	825	/* allocate some space on the context stack for our purposes */
803	/* we manually unroll here, as usually 2 slots is enough */	826	if (ecb_expect_false (cxstack_ix + (int)SLOT_COUNT >= cxstack_max))
804	if (SLOT_COUNT >= 1) CXINC;
805	if (SLOT_COUNT >= 2) CXINC;
806	if (SLOT_COUNT >= 3) CXINC;
807	{	827	{
808	unsigned int i;	828	unsigned int i;
		829
809	for (i = 3; i < SLOT_COUNT; ++i)	830	for (i = 0; i < SLOT_COUNT; ++i)
810	CXINC;	831	CXINC;
811	}	832
812	cxstack_ix -= SLOT_COUNT; /* undo allocation */	833	cxstack_ix -= SLOT_COUNT; /* undo allocation */
		834	}
813		835
814	c->mainstack = PL_mainstack;	836	c->mainstack = PL_mainstack;
815		837
816	{	838	{
817	perl_slots *slot = c->slot = (perl_slots *)(cxstack + cxstack_ix + 1);	839	perl_slots *slot = c->slot = (perl_slots *)(cxstack + cxstack_ix + 1);
818		840
819	slot->defav = GvAV (PL_defgv);	841	#if CORO_JIT
820	slot->defsv = DEFSV;	842	save_perl_slots (slot);
821	slot->errsv = ERRSV;	843	#else
822	slot->irsgv = GvSV (irsgv);
823	slot->hinthv = GvHV (PL_hintgv);
824
825	#define VAR(name,type) slot->name = PL_ ## name;	844	#define VARx(name,expr,type) slot->name = expr;
826	# include "state.h"	845	# include "state.h"
827	#undef VAR	846	#undef VARx
		847	#endif
828	}	848	}
829	}	849	}
830		850
831	/*	851	/*
832	* allocate various perl stacks. This is almost an exact copy	852	* allocate various perl stacks. This is almost an exact copy
…		…
838	# define coro_init_stacks(thx) init_stacks ()	858	# define coro_init_stacks(thx) init_stacks ()
839	#else	859	#else
840	static void	860	static void
841	coro_init_stacks (pTHX)	861	coro_init_stacks (pTHX)
842	{	862	{
843	PL_curstackinfo = new_stackinfo(32, 8);	863	PL_curstackinfo = new_stackinfo(32, 4 + SLOT_COUNT); /* 3 is minimum due to perl rounding down in scope.c:GROW() */
844	PL_curstackinfo->si_type = PERLSI_MAIN;	864	PL_curstackinfo->si_type = PERLSI_MAIN;
845	PL_curstack = PL_curstackinfo->si_stack;	865	PL_curstack = PL_curstackinfo->si_stack;
846	PL_mainstack = PL_curstack; /* remember in case we switch stacks */	866	PL_mainstack = PL_curstack; /* remember in case we switch stacks */
847		867
848	PL_stack_base = AvARRAY(PL_curstack);	868	PL_stack_base = AvARRAY(PL_curstack);
…		…
863	#endif	883	#endif
864		884
865	New(54,PL_scopestack,8,I32);	885	New(54,PL_scopestack,8,I32);
866	PL_scopestack_ix = 0;	886	PL_scopestack_ix = 0;
867	PL_scopestack_max = 8;	887	PL_scopestack_max = 8;
		888	#if HAS_SCOPESTACK_NAME
		889	New(54,PL_scopestack_name,8,const char*);
		890	#endif
868		891
869	New(54,PL_savestack,24,ANY);	892	New(54,PL_savestack,24,ANY);
870	PL_savestack_ix = 0;	893	PL_savestack_ix = 0;
871	PL_savestack_max = 24;	894	PL_savestack_max = 24;
872		895
…		…
900	}	923	}
901		924
902	Safefree (PL_tmps_stack);	925	Safefree (PL_tmps_stack);
903	Safefree (PL_markstack);	926	Safefree (PL_markstack);
904	Safefree (PL_scopestack);	927	Safefree (PL_scopestack);
		928	#if HAS_SCOPESTACK_NAME
		929	Safefree (PL_scopestack_name);
		930	#endif
905	Safefree (PL_savestack);	931	Safefree (PL_savestack);
906	#if !PERL_VERSION_ATLEAST (5,10,0)	932	#if !PERL_VERSION_ATLEAST (5,10,0)
907	Safefree (PL_retstack);	933	Safefree (PL_retstack);
908	#endif	934	#endif
909	}	935	}
…		…
955	#endif	981	#endif
956		982
957	/*	983	/*
958	* This overrides the default magic get method of %SIG elements.	984	* 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	985	* 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	986	* and instead of trying to save and restore the hash elements (extremely slow),
961	* readback here.	987	* we just provide our own readback here.
962	*/	988	*/
963	static int	989	static int ecb_cold
964	coro_sigelem_get (pTHX_ SV *sv, MAGIC *mg)	990	coro_sigelem_get (pTHX_ SV *sv, MAGIC *mg)
965	{	991	{
966	const char *s = MgPV_nolen_const (mg);	992	const char *s = MgPV_nolen_const (mg);
967		993
968	if (*s == '_')	994	if (*s == '_')
…		…
972	if (strEQ (s, "__DIE__" )) svp = &PL_diehook;	998	if (strEQ (s, "__DIE__" )) svp = &PL_diehook;
973	if (strEQ (s, "__WARN__")) svp = &PL_warnhook;	999	if (strEQ (s, "__WARN__")) svp = &PL_warnhook;
974		1000
975	if (svp)	1001	if (svp)
976	{	1002	{
977	sv_setsv (sv, *svp ? *svp : &PL_sv_undef);	1003	SV *ssv;
		1004
		1005	if (!*svp)
		1006	ssv = &PL_sv_undef;
		1007	else if (SvTYPE (*svp) == SVt_PVCV) /* perlio directly stores a CV in warnhook. ugh. */
		1008	ssv = sv_2mortal (newRV_inc (*svp));
		1009	else
		1010	ssv = *svp;
		1011
		1012	sv_setsv (sv, ssv);
978	return 0;	1013	return 0;
979	}	1014	}
980	}	1015	}
981		1016
982	return orig_sigelem_get ? orig_sigelem_get (aTHX_ sv, mg) : 0;	1017	return orig_sigelem_get ? orig_sigelem_get (aTHX_ sv, mg) : 0;
983	}	1018	}
984		1019
985	static int	1020	static int ecb_cold
986	coro_sigelem_clr (pTHX_ SV *sv, MAGIC *mg)	1021	coro_sigelem_clr (pTHX_ SV *sv, MAGIC *mg)
987	{	1022	{
988	const char *s = MgPV_nolen_const (mg);	1023	const char *s = MgPV_nolen_const (mg);
989		1024
990	if (*s == '_')	1025	if (*s == '_')
…		…
1004	}	1039	}
1005		1040
1006	return orig_sigelem_clr ? orig_sigelem_clr (aTHX_ sv, mg) : 0;	1041	return orig_sigelem_clr ? orig_sigelem_clr (aTHX_ sv, mg) : 0;
1007	}	1042	}
1008		1043
1009	static int	1044	static int ecb_cold
1010	coro_sigelem_set (pTHX_ SV *sv, MAGIC *mg)	1045	coro_sigelem_set (pTHX_ SV *sv, MAGIC *mg)
1011	{	1046	{
1012	const char *s = MgPV_nolen_const (mg);	1047	const char *s = MgPV_nolen_const (mg);
1013		1048
1014	if (*s == '_')	1049	if (*s == '_')
…		…
1049	return 1;	1084	return 1;
1050	}	1085	}
1051		1086
1052	static UNOP init_perl_op;	1087	static UNOP init_perl_op;
1053		1088
1054	static void NOINLINE /* noinline to keep it out of the transfer fast path */	1089	ecb_noinline static void /* noinline to keep it out of the transfer fast path */
1055	init_perl (pTHX_ struct coro *coro)	1090	init_perl (pTHX_ struct coro *coro)
1056	{	1091	{
1057	/*	1092	/*
1058	* emulate part of the perl startup here.	1093	* emulate part of the perl startup here.
1059	*/	1094	*/
…		…
1074	PL_parser = 0;	1109	PL_parser = 0;
1075	#endif	1110	#endif
1076	PL_hints = 0;	1111	PL_hints = 0;
1077		1112
1078	/* recreate the die/warn hooks */	1113	/* recreate the die/warn hooks */
1079	PL_diehook = 0; SvSetMagicSV (*hv_fetch (hv_sig, "__DIE__" , sizeof ("__DIE__" ) - 1, 1), rv_diehook );	1114	PL_diehook = SvREFCNT_inc (rv_diehook);
1080	PL_warnhook = 0; SvSetMagicSV (*hv_fetch (hv_sig, "__WARN__", sizeof ("__WARN__") - 1, 1), rv_warnhook);	1115	PL_warnhook = SvREFCNT_inc (rv_warnhook);
1081		1116
1082	GvSV (PL_defgv) = newSV (0);	1117	GvSV (PL_defgv) = newSV (0);
1083	GvAV (PL_defgv) = coro->args; coro->args = 0;	1118	GvAV (PL_defgv) = coro->args; coro->args = 0;
1084	GvSV (PL_errgv) = newSV (0);	1119	GvSV (PL_errgv) = newSV (0);
1085	GvSV (irsgv) = newSVpvn ("\n", 1); sv_magic (GvSV (irsgv), (SV *)irsgv, PERL_MAGIC_sv, "/", 0);	1120	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	1141	/* 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.	1142	* likely was suspended in pp_slf, so we have to emulate entering pp_slf here.
1108	*/	1143	*/
1109	slf_frame.prepare = prepare_nop; /* provide a nop function for an eventual pp_slf */	1144	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 */	1145	slf_frame.check = slf_check_nop; /* signal pp_slf to not repeat */
		1146	slf_frame.destroy = 0;
1111		1147
1112	/* and we have to provide the pp_slf op in any case, so pp_slf can skip it */	1148	/* 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;	1149	init_perl_op.op_next = PL_op;
1114	init_perl_op.op_type = OP_ENTERSUB;	1150	init_perl_op.op_type = OP_ENTERSUB;
1115	init_perl_op.op_ppaddr = pp_slf;	1151	init_perl_op.op_ppaddr = pp_slf;
…		…
1120	/* copy throw, in case it was set before init_perl */	1156	/* copy throw, in case it was set before init_perl */
1121	CORO_THROW = coro->except;	1157	CORO_THROW = coro->except;
1122		1158
1123	SWAP_SVS (coro);	1159	SWAP_SVS (coro);
1124		1160
1125	if (expect_false (enable_times))	1161	if (ecb_expect_false (enable_times))
1126	{	1162	{
1127	coro_times_update ();	1163	coro_times_update ();
1128	coro_times_sub (coro);	1164	coro_times_sub (coro);
1129	}	1165	}
1130	}	1166	}
…		…
1167	SvRV_set (coro_current, (SV *)coro->hv);	1203	SvRV_set (coro_current, (SV *)coro->hv);
1168		1204
1169	load_perl (aTHX_ coro);	1205	load_perl (aTHX_ coro);
1170		1206
1171	coro_unwind_stacks (aTHX);	1207	coro_unwind_stacks (aTHX);
1172	coro_destruct_stacks (aTHX);
1173		1208
1174	/* restore swapped sv's */	1209	/* restore swapped sv's */
1175	SWAP_SVS (coro);	1210	SWAP_SVS (coro);
1176		1211
		1212	coro_destruct_stacks (aTHX);
		1213
1177	// now save some sv's to be free'd later	1214	/* now save some sv's to be free'd later */
1178	svf [0] = GvSV (PL_defgv);	1215	svf [0] = GvSV (PL_defgv);
1179	svf [1] = (SV *)GvAV (PL_defgv);	1216	svf [1] = (SV *)GvAV (PL_defgv);
1180	svf [2] = GvSV (PL_errgv);	1217	svf [2] = GvSV (PL_errgv);
1181	svf [3] = (SV *)PL_defoutgv;	1218	svf [3] = (SV *)PL_defoutgv;
1182	svf [4] = PL_rs;	1219	svf [4] = PL_rs;
…		…
1202	SvREFCNT_dec (coro->invoke_cb);	1239	SvREFCNT_dec (coro->invoke_cb);
1203	SvREFCNT_dec (coro->invoke_av);	1240	SvREFCNT_dec (coro->invoke_av);
1204	}	1241	}
1205	}	1242	}
1206		1243
1207	INLINE void	1244	ecb_inline void
1208	free_coro_mortal (pTHX)	1245	free_coro_mortal (pTHX)
1209	{	1246	{
1210	if (expect_true (coro_mortal))	1247	if (ecb_expect_true (coro_mortal))
1211	{	1248	{
1212	SvREFCNT_dec (coro_mortal);	1249	SvREFCNT_dec ((SV *)coro_mortal);
1213	coro_mortal = 0;	1250	coro_mortal = 0;
1214	}	1251	}
1215	}	1252	}
1216		1253
1217	static int	1254	static int
…		…
1350		1387
1351	return frame->check (aTHX_ frame); /* execute the restored frame - there must be one */	1388	return frame->check (aTHX_ frame); /* execute the restored frame - there must be one */
1352	}	1389	}
1353		1390
1354	/* initialises PL_top_env and injects a pseudo-slf-call to set the stacklevel */	1391	/* initialises PL_top_env and injects a pseudo-slf-call to set the stacklevel */
1355	static void NOINLINE	1392	static void ecb_noinline
1356	cctx_prepare (pTHX)	1393	cctx_prepare (pTHX)
1357	{	1394	{
1358	PL_top_env = &PL_start_env;	1395	PL_top_env = &PL_start_env;
1359		1396
1360	if (cctx_current->flags & CC_TRACE)	1397	if (cctx_current->flags & CC_TRACE)
…		…
1371	slf_frame.prepare = slf_prepare_set_stacklevel;	1408	slf_frame.prepare = slf_prepare_set_stacklevel;
1372	slf_frame.check = slf_check_set_stacklevel;	1409	slf_frame.check = slf_check_set_stacklevel;
1373	}	1410	}
1374		1411
1375	/* the tail of transfer: execute stuff we can only do after a transfer */	1412	/* the tail of transfer: execute stuff we can only do after a transfer */
1376	INLINE void	1413	ecb_inline void
1377	transfer_tail (pTHX)	1414	transfer_tail (pTHX)
1378	{	1415	{
1379	free_coro_mortal (aTHX);	1416	free_coro_mortal (aTHX);
1380	}	1417	}
1381		1418
…		…
1425	JMPENV_JUMP (2); /* I do not feel well about the hardcoded 2 at all */	1462	JMPENV_JUMP (2); /* I do not feel well about the hardcoded 2 at all */
1426	}	1463	}
1427	}	1464	}
1428		1465
1429	static coro_cctx *	1466	static coro_cctx *
1430	cctx_new ()	1467	cctx_new (void)
1431	{	1468	{
1432	coro_cctx *cctx;	1469	coro_cctx *cctx;
1433		1470
1434	++cctx_count;	1471	++cctx_count;
1435	New (0, cctx, 1, coro_cctx);	1472	New (0, cctx, 1, coro_cctx);
…		…
1441	return cctx;	1478	return cctx;
1442	}	1479	}
1443		1480
1444	/* create a new cctx only suitable as source */	1481	/* create a new cctx only suitable as source */
1445	static coro_cctx *	1482	static coro_cctx *
1446	cctx_new_empty ()	1483	cctx_new_empty (void)
1447	{	1484	{
1448	coro_cctx *cctx = cctx_new ();	1485	coro_cctx *cctx = cctx_new ();
1449		1486
1450	cctx->sptr = 0;	1487	cctx->sptr = 0;
1451	coro_create (&cctx->cctx, 0, 0, 0, 0);	1488	coro_create (&cctx->cctx, 0, 0, 0, 0);
…		…
1453	return cctx;	1490	return cctx;
1454	}	1491	}
1455		1492
1456	/* create a new cctx suitable as destination/running a perl interpreter */	1493	/* create a new cctx suitable as destination/running a perl interpreter */
1457	static coro_cctx *	1494	static coro_cctx *
1458	cctx_new_run ()	1495	cctx_new_run (void)
1459	{	1496	{
1460	coro_cctx *cctx = cctx_new ();	1497	coro_cctx *cctx = cctx_new ();
1461	void *stack_start;	1498	void *stack_start;
1462	size_t stack_size;	1499	size_t stack_size;
1463		1500
1464	#if HAVE_MMAP	1501	#if HAVE_MMAP
1465	cctx->ssize = ((cctx_stacksize * sizeof (long) + PAGESIZE - 1) / PAGESIZE + CORO_STACKGUARD) * PAGESIZE;	1502	cctx->ssize = ((cctx_stacksize * sizeof (long) + PAGESIZE - 1) / PAGESIZE + CORO_STACKGUARD) * PAGESIZE;
1466	/* mmap supposedly does allocate-on-write for us */	1503	/* mmap supposedly does allocate-on-write for us */
1467	cctx->sptr = mmap (0, cctx->ssize, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_PRIVATE|MAP_ANONYMOUS, 0, 0);	1504	cctx->sptr = mmap (0, cctx->ssize, PROT_READ | PROT_WRITE | PROT_EXEC, MAP_ANONYMOUS, 0, 0);
1468		1505
1469	if (cctx->sptr != (void *)-1)	1506	if (cctx->sptr != (void *)-1)
1470	{	1507	{
1471	#if CORO_STACKGUARD	1508	#if CORO_STACKGUARD
1472	mprotect (cctx->sptr, CORO_STACKGUARD * PAGESIZE, PROT_NONE);	1509	mprotect (cctx->sptr, CORO_STACKGUARD * PAGESIZE, PROT_NONE);
…		…
1533	#define CCTX_EXPIRED(cctx) ((cctx)->gen != cctx_gen || ((cctx)->flags & CC_NOREUSE))	1570	#define CCTX_EXPIRED(cctx) ((cctx)->gen != cctx_gen || ((cctx)->flags & CC_NOREUSE))
1534		1571
1535	static coro_cctx *	1572	static coro_cctx *
1536	cctx_get (pTHX)	1573	cctx_get (pTHX)
1537	{	1574	{
1538	while (expect_true (cctx_first))	1575	while (ecb_expect_true (cctx_first))
1539	{	1576	{
1540	coro_cctx *cctx = cctx_first;	1577	coro_cctx *cctx = cctx_first;
1541	cctx_first = cctx->next;	1578	cctx_first = cctx->next;
1542	--cctx_idle;	1579	--cctx_idle;
1543		1580
1544	if (expect_true (!CCTX_EXPIRED (cctx)))	1581	if (ecb_expect_true (!CCTX_EXPIRED (cctx)))
1545	return cctx;	1582	return cctx;
1546		1583
1547	cctx_destroy (cctx);	1584	cctx_destroy (cctx);
1548	}	1585	}
1549		1586
…		…
1554	cctx_put (coro_cctx *cctx)	1591	cctx_put (coro_cctx *cctx)
1555	{	1592	{
1556	assert (("FATAL: cctx_put called on non-initialised cctx in Coro (please report)", cctx->sptr));	1593	assert (("FATAL: cctx_put called on non-initialised cctx in Coro (please report)", cctx->sptr));
1557		1594
1558	/* free another cctx if overlimit */	1595	/* free another cctx if overlimit */
1559	if (expect_false (cctx_idle >= cctx_max_idle))	1596	if (ecb_expect_false (cctx_idle >= cctx_max_idle))
1560	{	1597	{
1561	coro_cctx *first = cctx_first;	1598	coro_cctx *first = cctx_first;
1562	cctx_first = first->next;	1599	cctx_first = first->next;
1563	--cctx_idle;	1600	--cctx_idle;
1564		1601
…		…
1575	static void	1612	static void
1576	transfer_check (pTHX_ struct coro *prev, struct coro *next)	1613	transfer_check (pTHX_ struct coro *prev, struct coro *next)
1577	{	1614	{
1578	/* TODO: throwing up here is considered harmful */	1615	/* TODO: throwing up here is considered harmful */
1579		1616
1580	if (expect_true (prev != next))	1617	if (ecb_expect_true (prev != next))
1581	{	1618	{
1582	if (expect_false (!(prev->flags & (CF_RUNNING | CF_NEW))))	1619	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,");	1620	croak ("Coro::State::transfer called with a blocked prev Coro::State, but can only transfer from running or new states,");
1584		1621
1585	if (expect_false (next->flags & (CF_RUNNING | CF_DESTROYED | CF_SUSPENDED)))	1622	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,");	1623	croak ("Coro::State::transfer called with running, destroyed or suspended next Coro::State, but can only transfer to inactive states,");
1587		1624
1588	#if !PERL_VERSION_ATLEAST (5,10,0)	1625	#if !PERL_VERSION_ATLEAST (5,10,0)
1589	if (expect_false (PL_lex_state != LEX_NOTPARSING))	1626	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,");	1627	croak ("Coro::State::transfer called while parsing, but this is not supported in your perl version,");
1591	#endif	1628	#endif
1592	}	1629	}
1593	}	1630	}
1594		1631
1595	/* always use the TRANSFER macro */	1632	/* always use the TRANSFER macro */
1596	static void NOINLINE /* noinline so we have a fixed stackframe */	1633	static void ecb_noinline /* noinline so we have a fixed stackframe */
1597	transfer (pTHX_ struct coro *prev, struct coro *next, int force_cctx)	1634	transfer (pTHX_ struct coro *prev, struct coro *next, int force_cctx)
1598	{	1635	{
1599	dSTACKLEVEL;	1636	dSTACKLEVEL;
1600		1637
1601	/* sometimes transfer is only called to set idle_sp */	1638	/* sometimes transfer is only called to set idle_sp */
1602	if (expect_false (!prev))	1639	if (ecb_expect_false (!prev))
1603	{	1640	{
1604	cctx_current->idle_sp = STACKLEVEL;	1641	cctx_current->idle_sp = STACKLEVEL;
1605	assert (cctx_current->idle_te = PL_top_env); /* just for the side-effect when asserts are enabled */	1642	assert (cctx_current->idle_te = PL_top_env); /* just for the side-effect when asserts are enabled */
1606	}	1643	}
1607	else if (expect_true (prev != next))	1644	else if (ecb_expect_true (prev != next))
1608	{	1645	{
1609	coro_cctx *cctx_prev;	1646	coro_cctx *cctx_prev;
1610		1647
1611	if (expect_false (prev->flags & CF_NEW))	1648	if (ecb_expect_false (prev->flags & CF_NEW))
1612	{	1649	{
1613	/* create a new empty/source context */	1650	/* create a new empty/source context */
1614	prev->flags &= ~CF_NEW;	1651	prev->flags &= ~CF_NEW;
1615	prev->flags |= CF_RUNNING;	1652	prev->flags |= CF_RUNNING;
1616	}	1653	}
…		…
1619	next->flags |= CF_RUNNING;	1656	next->flags |= CF_RUNNING;
1620		1657
1621	/* first get rid of the old state */	1658	/* first get rid of the old state */
1622	save_perl (aTHX_ prev);	1659	save_perl (aTHX_ prev);
1623		1660
1624	if (expect_false (next->flags & CF_NEW))	1661	if (ecb_expect_false (next->flags & CF_NEW))
1625	{	1662	{
1626	/* need to start coroutine */	1663	/* need to start coroutine */
1627	next->flags &= ~CF_NEW;	1664	next->flags &= ~CF_NEW;
1628	/* setup coroutine call */	1665	/* setup coroutine call */
1629	init_perl (aTHX_ next);	1666	init_perl (aTHX_ next);
1630	}	1667	}
1631	else	1668	else
1632	load_perl (aTHX_ next);	1669	load_perl (aTHX_ next);
1633		1670
1634	/* possibly untie and reuse the cctx */	1671	/* possibly untie and reuse the cctx */
1635	if (expect_true (	1672	if (ecb_expect_true (
1636	cctx_current->idle_sp == STACKLEVEL	1673	cctx_current->idle_sp == STACKLEVEL
1637	&& !(cctx_current->flags & CC_TRACE)	1674	&& !(cctx_current->flags & CC_TRACE)
1638	&& !force_cctx	1675	&& !force_cctx
1639	))	1676	))
1640	{	1677	{
1641	/* I assume that stacklevel is a stronger indicator than PL_top_env changes */	1678	/* 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));	1679	assert (("FATAL: current top_env must equal previous top_env in Coro (please report)", PL_top_env == cctx_current->idle_te));
1643		1680
1644	/* if the cctx is about to be destroyed we need to make sure we won't see it in cctx_get. */	1681	/* 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 */	1682	/* without this the next cctx_get might destroy the running cctx while still in use */
1646	if (expect_false (CCTX_EXPIRED (cctx_current)))	1683	if (ecb_expect_false (CCTX_EXPIRED (cctx_current)))
1647	if (expect_true (!next->cctx))	1684	if (ecb_expect_true (!next->cctx))
1648	next->cctx = cctx_get (aTHX);	1685	next->cctx = cctx_get (aTHX);
1649		1686
1650	cctx_put (cctx_current);	1687	cctx_put (cctx_current);
1651	}	1688	}
1652	else	1689	else
1653	prev->cctx = cctx_current;	1690	prev->cctx = cctx_current;
1654		1691
1655	++next->usecount;	1692	++next->usecount;
1656		1693
1657	cctx_prev = cctx_current;	1694	cctx_prev = cctx_current;
1658	cctx_current = expect_false (next->cctx) ? next->cctx : cctx_get (aTHX);	1695	cctx_current = ecb_expect_false (next->cctx) ? next->cctx : cctx_get (aTHX);
1659		1696
1660	next->cctx = 0;	1697	next->cctx = 0;
1661		1698
1662	if (expect_false (cctx_prev != cctx_current))	1699	if (ecb_expect_false (cctx_prev != cctx_current))
1663	{	1700	{
1664	cctx_prev->top_env = PL_top_env;	1701	cctx_prev->top_env = PL_top_env;
1665	PL_top_env = cctx_current->top_env;	1702	PL_top_env = cctx_current->top_env;
1666	coro_transfer (&cctx_prev->cctx, &cctx_current->cctx);	1703	coro_transfer (&cctx_prev->cctx, &cctx_current->cctx);
1667	}	1704	}
…		…
1673	#define TRANSFER(ta, force_cctx) transfer (aTHX_ (ta).prev, (ta).next, (force_cctx))	1710	#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)	1711	#define TRANSFER_CHECK(ta) transfer_check (aTHX_ (ta).prev, (ta).next)
1675		1712
1676	/** high level stuff ********************************************************/	1713	/** high level stuff ********************************************************/
1677		1714
		1715	/* this function is actually Coro, not Coro::State, but we call it from here */
		1716	/* because it is convenient - but it hasn't been declared yet for that reason */
		1717	static void
		1718	coro_call_on_destroy (pTHX_ struct coro *coro);
		1719
1678	static void	1720	static void
1679	coro_state_destroy (pTHX_ struct coro *coro)	1721	coro_state_destroy (pTHX_ struct coro *coro)
1680	{	1722	{
1681	if (coro->flags & CF_DESTROYED)	1723	if (coro->flags & CF_ZOMBIE)
1682	return;	1724	return;
1683		1725
1684	slf_destroy (aTHX_ coro);	1726	slf_destroy (aTHX_ coro);
1685		1727
1686	coro->flags |= CF_DESTROYED;	1728	coro->flags |= CF_ZOMBIE;
1687		1729
1688	if (coro->flags & CF_READY)	1730	if (coro->flags & CF_READY)
1689	{	1731	{
1690	/* reduce nready, as destroying a ready coro effectively unreadies it */	1732	/* reduce nready, as destroying a ready coro effectively unreadies it */
1691	/* alternative: look through all ready queues and remove the coro */	1733	/* alternative: look through all ready queues and remove the coro */
1692	--coro_nready;	1734	--coro_nready;
1693	}	1735	}
1694	else	1736	else
1695	coro->flags |= CF_READY; /* make sure it is NOT put into the readyqueue */	1737	coro->flags |= CF_READY; /* make sure it is NOT put into the readyqueue */
		1738
		1739	if (coro->next) coro->next->prev = coro->prev;
		1740	if (coro->prev) coro->prev->next = coro->next;
		1741	if (coro == coro_first) coro_first = coro->next;
1696		1742
1697	if (coro->mainstack	1743	if (coro->mainstack
1698	&& coro->mainstack != main_mainstack	1744	&& coro->mainstack != main_mainstack
1699	&& coro->slot	1745	&& coro->slot
1700	&& !PL_dirty)	1746	&& !PL_dirty)
1701	destroy_perl (aTHX_ coro);	1747	destroy_perl (aTHX_ coro);
1702		1748
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);	1749	cctx_destroy (coro->cctx);
1708	SvREFCNT_dec (coro->startcv);	1750	SvREFCNT_dec (coro->startcv);
1709	SvREFCNT_dec (coro->args);	1751	SvREFCNT_dec (coro->args);
1710	SvREFCNT_dec (coro->swap_sv);	1752	SvREFCNT_dec (coro->swap_sv);
1711	SvREFCNT_dec (CORO_THROW);	1753	SvREFCNT_dec (CORO_THROW);
		1754
		1755	coro_call_on_destroy (aTHX_ coro);
		1756
		1757	/* more destruction mayhem in coro_state_free */
1712	}	1758	}
1713		1759
1714	static int	1760	static int
1715	coro_state_free (pTHX_ SV *sv, MAGIC *mg)	1761	coro_state_free (pTHX_ SV *sv, MAGIC *mg)
1716	{	1762	{
1717	struct coro *coro = (struct coro *)mg->mg_ptr;	1763	struct coro *coro = (struct coro *)mg->mg_ptr;
1718	mg->mg_ptr = 0;	1764	mg->mg_ptr = 0;
1719		1765
1720	coro->hv = 0;
1721
1722	if (--coro->refcnt < 0)
1723	{
1724	coro_state_destroy (aTHX_ coro);	1766	coro_state_destroy (aTHX_ coro);
		1767	SvREFCNT_dec (coro->on_destroy);
		1768	SvREFCNT_dec (coro->status);
		1769
1725	Safefree (coro);	1770	Safefree (coro);
1726	}
1727		1771
1728	return 0;	1772	return 0;
1729	}	1773	}
1730		1774
1731	static int	1775	static int ecb_cold
1732	coro_state_dup (pTHX_ MAGIC *mg, CLONE_PARAMS *params)	1776	coro_state_dup (pTHX_ MAGIC *mg, CLONE_PARAMS *params)
1733	{	1777	{
1734	struct coro *coro = (struct coro *)mg->mg_ptr;	1778	/* called when perl clones the current process the slow way (windows process emulation) */
1735		1779	/* WE SIMply nuke the pointers in the copy, causing perl to croak */
1736	++coro->refcnt;	1780	mg->mg_ptr = 0;
		1781	mg->mg_virtual = 0;
1737		1782
1738	return 0;	1783	return 0;
1739	}	1784	}
1740		1785
1741	static MGVTBL coro_state_vtbl = {	1786	static MGVTBL coro_state_vtbl = {
…		…
1766	TRANSFER (ta, 1);	1811	TRANSFER (ta, 1);
1767	}	1812	}
1768		1813
1769	/** Coro ********************************************************************/	1814	/** Coro ********************************************************************/
1770		1815
1771	INLINE void	1816	ecb_inline void
1772	coro_enq (pTHX_ struct coro *coro)	1817	coro_enq (pTHX_ struct coro *coro)
1773	{	1818	{
1774	struct coro **ready = coro_ready [coro->prio - CORO_PRIO_MIN];	1819	struct coro **ready = coro_ready [coro->prio - CORO_PRIO_MIN];
1775		1820
1776	SvREFCNT_inc_NN (coro->hv);	1821	SvREFCNT_inc_NN (coro->hv);
…		…
1778	coro->next_ready = 0;	1823	coro->next_ready = 0;
1779	*(ready [0] ? &ready [1]->next_ready : &ready [0]) = coro;	1824	*(ready [0] ? &ready [1]->next_ready : &ready [0]) = coro;
1780	ready [1] = coro;	1825	ready [1] = coro;
1781	}	1826	}
1782		1827
1783	INLINE struct coro *	1828	ecb_inline struct coro *
1784	coro_deq (pTHX)	1829	coro_deq (pTHX)
1785	{	1830	{
1786	int prio;	1831	int prio;
1787		1832
1788	for (prio = CORO_PRIO_MAX - CORO_PRIO_MIN + 1; --prio >= 0; )	1833	for (prio = CORO_PRIO_MAX - CORO_PRIO_MIN + 1; --prio >= 0; )
…		…
1841	{	1886	{
1842	return !!(SvSTATE (coro_sv)->flags & CF_READY);	1887	return !!(SvSTATE (coro_sv)->flags & CF_READY);
1843	}	1888	}
1844		1889
1845	/* expects to own a reference to next->hv */	1890	/* expects to own a reference to next->hv */
1846	INLINE void	1891	ecb_inline void
1847	prepare_schedule_to (pTHX_ struct coro_transfer_args *ta, struct coro *next)	1892	prepare_schedule_to (pTHX_ struct coro_transfer_args *ta, struct coro *next)
1848	{	1893	{
1849	SV *prev_sv = SvRV (coro_current);	1894	SV *prev_sv = SvRV (coro_current);
1850		1895
1851	ta->prev = SvSTATE_hv (prev_sv);	1896	ta->prev = SvSTATE_hv (prev_sv);
…		…
1864	{	1909	{
1865	for (;;)	1910	for (;;)
1866	{	1911	{
1867	struct coro *next = coro_deq (aTHX);	1912	struct coro *next = coro_deq (aTHX);
1868		1913
1869	if (expect_true (next))	1914	if (ecb_expect_true (next))
1870	{	1915	{
1871	/* cannot transfer to destroyed coros, skip and look for next */	1916	/* cannot transfer to destroyed coros, skip and look for next */
1872	if (expect_false (next->flags & (CF_DESTROYED | CF_SUSPENDED)))	1917	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 */	1918	SvREFCNT_dec (next->hv); /* coro_nready has already been taken care of by destroy */
1874	else	1919	else
1875	{	1920	{
1876	next->flags &= ~CF_READY;	1921	next->flags &= ~CF_READY;
1877	--coro_nready;	1922	--coro_nready;
…		…
1910	}	1955	}
1911	}	1956	}
1912	}	1957	}
1913	}	1958	}
1914		1959
1915	INLINE void	1960	ecb_inline void
1916	prepare_cede (pTHX_ struct coro_transfer_args *ta)	1961	prepare_cede (pTHX_ struct coro_transfer_args *ta)
1917	{	1962	{
1918	api_ready (aTHX_ coro_current);	1963	api_ready (aTHX_ coro_current);
1919	prepare_schedule (aTHX_ ta);	1964	prepare_schedule (aTHX_ ta);
1920	}	1965	}
1921		1966
1922	INLINE void	1967	ecb_inline void
1923	prepare_cede_notself (pTHX_ struct coro_transfer_args *ta)	1968	prepare_cede_notself (pTHX_ struct coro_transfer_args *ta)
1924	{	1969	{
1925	SV *prev = SvRV (coro_current);	1970	SV *prev = SvRV (coro_current);
1926		1971
1927	if (coro_nready)	1972	if (coro_nready)
…		…
1957	{	2002	{
1958	struct coro_transfer_args ta;	2003	struct coro_transfer_args ta;
1959		2004
1960	prepare_cede (aTHX_ &ta);	2005	prepare_cede (aTHX_ &ta);
1961		2006
1962	if (expect_true (ta.prev != ta.next))	2007	if (ecb_expect_true (ta.prev != ta.next))
1963	{	2008	{
1964	TRANSFER (ta, 1);	2009	TRANSFER (ta, 1);
1965	return 1;	2010	return 1;
1966	}	2011	}
1967	else	2012	else
…		…
2010	coro->slot->runops = RUNOPS_DEFAULT;	2055	coro->slot->runops = RUNOPS_DEFAULT;
2011	}	2056	}
2012	}	2057	}
2013		2058
2014	static void	2059	static void
		2060	coro_push_av (pTHX_ AV *av, I32 gimme_v)
		2061	{
		2062	if (AvFILLp (av) >= 0 && gimme_v != G_VOID)
		2063	{
		2064	dSP;
		2065
		2066	if (gimme_v == G_SCALAR)
		2067	XPUSHs (AvARRAY (av)[AvFILLp (av)]);
		2068	else
		2069	{
		2070	int i;
		2071	EXTEND (SP, AvFILLp (av) + 1);
		2072
		2073	for (i = 0; i <= AvFILLp (av); ++i)
		2074	PUSHs (AvARRAY (av)[i]);
		2075	}
		2076
		2077	PUTBACK;
		2078	}
		2079	}
		2080
		2081	static void
		2082	coro_push_on_destroy (pTHX_ struct coro *coro, SV *cb)
		2083	{
		2084	if (!coro->on_destroy)
		2085	coro->on_destroy = newAV ();
		2086
		2087	av_push (coro->on_destroy, cb);
		2088	}
		2089
		2090	static void
		2091	slf_destroy_join (pTHX_ struct CoroSLF *frame)
		2092	{
		2093	SvREFCNT_dec ((SV *)((struct coro *)frame->data)->hv);
		2094	}
		2095
		2096	static int
		2097	slf_check_join (pTHX_ struct CoroSLF *frame)
		2098	{
		2099	struct coro *coro = (struct coro *)frame->data;
		2100
		2101	if (!coro->status)
		2102	return 1;
		2103
		2104	frame->destroy = 0;
		2105
		2106	coro_push_av (aTHX_ coro->status, GIMME_V);
		2107
		2108	SvREFCNT_dec ((SV *)coro->hv);
		2109
		2110	return 0;
		2111	}
		2112
		2113	static void
		2114	slf_init_join (pTHX_ struct CoroSLF *frame, CV *cv, SV **arg, int items)
		2115	{
		2116	struct coro *coro = SvSTATE (items > 0 ? arg [0] : &PL_sv_undef);
		2117
		2118	if (items > 1)
		2119	croak ("join called with too many arguments");
		2120
		2121	if (coro->status)
		2122	frame->prepare = prepare_nop;
		2123	else
		2124	{
		2125	coro_push_on_destroy (aTHX_ coro, SvREFCNT_inc_NN (SvRV (coro_current)));
		2126	frame->prepare = prepare_schedule;
		2127	}
		2128
		2129	frame->check = slf_check_join;
		2130	frame->destroy = slf_destroy_join;
		2131	frame->data = (void *)coro;
		2132	SvREFCNT_inc (coro->hv);
		2133	}
		2134
		2135	static void
2015	coro_call_on_destroy (pTHX_ struct coro *coro)	2136	coro_call_on_destroy (pTHX_ struct coro *coro)
2016	{	2137	{
2017	SV **on_destroyp = hv_fetch (coro->hv, "_on_destroy", sizeof ("_on_destroy") - 1, 0);	2138	AV *od = coro->on_destroy;
2018		2139
2019	if (on_destroyp)	2140	if (!od)
2020	{	2141	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		2142
2025	while (AvFILLp (on_destroy) >= 0)	2143	while (AvFILLp (od) >= 0)
		2144	{
		2145	SV *cb = sv_2mortal (av_pop (od));
		2146
		2147	/* coro hv's (and only hv's at the moment) are supported as well */
		2148	if (SvSTATEhv_p (aTHX_ cb))
		2149	api_ready (aTHX_ cb);
		2150	else
2026	{	2151	{
2027	dSP; /* don't disturb outer sp */	2152	dSP; /* don't disturb outer sp */
2028	SV *cb = av_pop (on_destroy);
2029
2030	PUSHMARK (SP);	2153	PUSHMARK (SP);
2031		2154
2032	if (statusp)	2155	if (coro->status)
2033	{	2156	{
2034	int i;	2157	PUTBACK;
2035	EXTEND (SP, AvFILLp (status) + 1);	2158	coro_push_av (aTHX_ coro->status, G_ARRAY);
2036		2159	SPAGAIN;
2037	for (i = 0; i <= AvFILLp (status); ++i)
2038	PUSHs (AvARRAY (status)[i]);
2039	}	2160	}
2040		2161
2041	PUTBACK;	2162	PUTBACK;
2042	call_sv (sv_2mortal (cb), G_VOID | G_DISCARD);	2163	call_sv (cb, G_VOID | G_DISCARD);
2043	}	2164	}
2044	}	2165	}
2045	}	2166	}
2046		2167
2047	static void	2168	static void
2048	coro_set_status (HV *coro_hv, SV **arg, int items)	2169	coro_set_status (pTHX_ struct coro *coro, SV **arg, int items)
2049	{	2170	{
2050	AV *av = newAV ();	2171	AV *av;
		2172
		2173	if (coro->status)
		2174	{
		2175	av = coro->status;
		2176	av_clear (av);
		2177	}
		2178	else
		2179	av = coro->status = newAV ();
2051		2180
2052	/* items are actually not so common, so optimise for this case */	2181	/* items are actually not so common, so optimise for this case */
2053	if (items)	2182	if (items)
2054	{	2183	{
2055	int i;	2184	int i;
…		…
2057	av_extend (av, items - 1);	2186	av_extend (av, items - 1);
2058		2187
2059	for (i = 0; i < items; ++i)	2188	for (i = 0; i < items; ++i)
2060	av_push (av, SvREFCNT_inc_NN (arg [i]));	2189	av_push (av, SvREFCNT_inc_NN (arg [i]));
2061	}	2190	}
2062
2063	hv_store (coro_hv, "_status", sizeof ("_status") - 1, newRV_noinc ((SV *)av), 0);
2064	}	2191	}
2065		2192
2066	static void	2193	static void
2067	slf_init_terminate_cancel_common (pTHX_ struct CoroSLF *frame, HV *coro_hv)	2194	slf_init_terminate_cancel_common (pTHX_ struct CoroSLF *frame, HV *coro_hv)
2068	{	2195	{
…		…
2080	static void	2207	static void
2081	slf_init_terminate (pTHX_ struct CoroSLF *frame, CV *cv, SV **arg, int items)	2208	slf_init_terminate (pTHX_ struct CoroSLF *frame, CV *cv, SV **arg, int items)
2082	{	2209	{
2083	HV *coro_hv = (HV *)SvRV (coro_current);	2210	HV *coro_hv = (HV *)SvRV (coro_current);
2084		2211
2085	coro_set_status (coro_hv, arg, items);	2212	coro_set_status (aTHX_ SvSTATE ((SV *)coro_hv), arg, items);
2086	slf_init_terminate_cancel_common (frame, coro_hv);	2213	slf_init_terminate_cancel_common (aTHX_ frame, coro_hv);
2087	}	2214	}
2088		2215
2089	static void	2216	static void
2090	slf_init_cancel (pTHX_ struct CoroSLF *frame, CV *cv, SV **arg, int items)	2217	slf_init_cancel (pTHX_ struct CoroSLF *frame, CV *cv, SV **arg, int items)
2091	{	2218	{
…		…
2096	croak ("Coro::cancel called without coro object,");	2223	croak ("Coro::cancel called without coro object,");
2097		2224
2098	coro = SvSTATE (arg [0]);	2225	coro = SvSTATE (arg [0]);
2099	coro_hv = coro->hv;	2226	coro_hv = coro->hv;
2100		2227
2101	coro_set_status (coro_hv, arg + 1, items - 1);	2228	coro_set_status (aTHX_ coro, arg + 1, items - 1);
2102		2229
2103	if (expect_false (coro->flags & CF_NOCANCEL))	2230	if (ecb_expect_false (coro->flags & CF_NOCANCEL))
2104	{	2231	{
2105	/* coro currently busy cancelling something, so just notify it */	2232	/* coro currently busy cancelling something, so just notify it */
2106	coro->slf_frame.data = (void *)coro;	2233	coro->slf_frame.data = (void *)coro;
2107		2234
2108	frame->prepare = prepare_nop;	2235	frame->prepare = prepare_nop;
2109	frame->check = slf_check_nop;	2236	frame->check = slf_check_nop;
2110	}	2237	}
2111	else if (coro_hv == (HV *)SvRV (coro_current))	2238	else if (coro_hv == (HV *)SvRV (coro_current))
2112	{	2239	{
2113	/* cancelling the current coro is allowed, and equals terminate */	2240	/* cancelling the current coro is allowed, and equals terminate */
2114	slf_init_terminate_cancel_common (frame, coro_hv);	2241	slf_init_terminate_cancel_common (aTHX_ frame, coro_hv);
2115	}	2242	}
2116	else	2243	else
2117	{	2244	{
2118	struct coro *self = SvSTATE_current;	2245	struct coro *self = SvSTATE_current;
2119		2246
…		…
2123	* this is ugly, and hopefully fully worth the extra speed.	2250	* this is ugly, and hopefully fully worth the extra speed.
2124	* besides, I can't get the slow-but-safe version working...	2251	* besides, I can't get the slow-but-safe version working...
2125	*/	2252	*/
2126	slf_frame.data = 0;	2253	slf_frame.data = 0;
2127	self->flags |= CF_NOCANCEL;	2254	self->flags |= CF_NOCANCEL;
2128
2129	coro_state_destroy (aTHX_ coro);	2255	coro_state_destroy (aTHX_ coro);
2130	coro_call_on_destroy (aTHX_ coro);
2131
2132	self->flags &= ~CF_NOCANCEL;	2256	self->flags &= ~CF_NOCANCEL;
2133		2257
2134	if (slf_frame.data)	2258	if (slf_frame.data)
2135	{	2259	{
2136	/* while we were busy we have been cancelled, so terminate */	2260	/* while we were busy we have been cancelled, so terminate */
2137	slf_init_terminate_cancel_common (frame, self->hv);	2261	slf_init_terminate_cancel_common (aTHX_ frame, self->hv);
2138	}	2262	}
2139	else	2263	else
2140	{	2264	{
2141	frame->prepare = prepare_nop;	2265	frame->prepare = prepare_nop;
2142	frame->check = slf_check_nop;	2266	frame->check = slf_check_nop;
…		…
2146		2270
2147	static int	2271	static int
2148	slf_check_safe_cancel (pTHX_ struct CoroSLF *frame)	2272	slf_check_safe_cancel (pTHX_ struct CoroSLF *frame)
2149	{	2273	{
2150	frame->prepare = 0;	2274	frame->prepare = 0;
2151	coro_unwind_stacks ();	2275	coro_unwind_stacks (aTHX);
2152		2276
2153	slf_init_terminate_cancel_common (aTHX_ frame, (HV *)SvRV (coro_current));	2277	slf_init_terminate_cancel_common (aTHX_ frame, (HV *)SvRV (coro_current));
2154		2278
2155	return 1;	2279	return 1;
2156	}	2280	}
…		…
2161	if (coro->cctx)	2285	if (coro->cctx)
2162	croak ("coro inside C callback, unable to cancel at this time, caught");	2286	croak ("coro inside C callback, unable to cancel at this time, caught");
2163		2287
2164	if (coro->flags & CF_NEW)	2288	if (coro->flags & CF_NEW)
2165	{	2289	{
2166	coro_set_status (coro->hv, arg, items);	2290	coro_set_status (aTHX_ coro, arg, items);
2167	coro_state_destroy (aTHX_ coro);	2291	coro_state_destroy (aTHX_ coro);
2168	coro_call_on_destroy (aTHX_ coro);
2169	}	2292	}
2170	else	2293	else
2171	{	2294	{
2172	if (!coro->slf_frame.prepare)	2295	if (!coro->slf_frame.prepare)
2173	croak ("coro outside an SLF function, unable to cancel at this time, caught");	2296	croak ("coro outside an SLF function, unable to cancel at this time, caught");
2174		2297
2175	slf_destroy (coro);	2298	slf_destroy (aTHX_ coro);
2176		2299
2177	coro_set_status (coro->hv, arg, items);	2300	coro_set_status (aTHX_ coro, arg, items);
2178	coro->slf_frame.prepare = prepare_nop;	2301	coro->slf_frame.prepare = prepare_nop;
2179	coro->slf_frame.check = slf_check_safe_cancel;	2302	coro->slf_frame.check = slf_check_safe_cancel;
2180		2303
2181	api_ready (aTHX_ coro->hv);	2304	api_ready (aTHX_ (SV *)coro->hv);
2182	}	2305	}
2183		2306
2184	return 1;	2307	return 1;
2185	}	2308	}
2186		2309
…		…
2220	slf_init_pool_handler (pTHX_ struct CoroSLF *frame, CV *cv, SV **arg, int items)	2343	slf_init_pool_handler (pTHX_ struct CoroSLF *frame, CV *cv, SV **arg, int items)
2221	{	2344	{
2222	HV *hv = (HV *)SvRV (coro_current);	2345	HV *hv = (HV *)SvRV (coro_current);
2223	struct coro *coro = SvSTATE_hv ((SV *)hv);	2346	struct coro *coro = SvSTATE_hv ((SV *)hv);
2224		2347
2225	if (expect_true (coro->saved_deffh))	2348	if (ecb_expect_true (coro->saved_deffh))
2226	{	2349	{
2227	/* subsequent iteration */	2350	/* subsequent iteration */
2228	SvREFCNT_dec ((SV *)PL_defoutgv); PL_defoutgv = (GV *)coro->saved_deffh;	2351	SvREFCNT_dec ((SV *)PL_defoutgv); PL_defoutgv = (GV *)coro->saved_deffh;
2229	coro->saved_deffh = 0;	2352	coro->saved_deffh = 0;
2230		2353
…		…
2471	static void	2594	static void
2472	slf_destroy (pTHX_ struct coro *coro)	2595	slf_destroy (pTHX_ struct coro *coro)
2473	{	2596	{
2474	/* this callback is reserved for slf functions needing to do cleanup */	2597	/* this callback is reserved for slf functions needing to do cleanup */
2475	if (coro->slf_frame.destroy && coro->slf_frame.prepare && !PL_dirty)	2598	if (coro->slf_frame.destroy && coro->slf_frame.prepare && !PL_dirty)
2476	coro->slf_frame.destroy (aTHX_ coro);	2599	coro->slf_frame.destroy (aTHX_ &coro->slf_frame);
2477		2600
2478	/*	2601	/*
2479	* The on_destroy above most likely is from an SLF call.	2602	* The on_destroy above most likely is from an SLF call.
2480	* Since by definition the SLF call will not finish when we destroy	2603	* Since by definition the SLF call will not finish when we destroy
2481	* the coro, we will have to force-finish it here, otherwise	2604	* the coro, we will have to force-finish it here, otherwise
…		…
2496	I32 checkmark; /* mark SP to see how many elements check has pushed */	2619	I32 checkmark; /* mark SP to see how many elements check has pushed */
2497		2620
2498	/* set up the slf frame, unless it has already been set-up */	2621	/* set up the slf frame, unless it has already been set-up */
2499	/* the latter happens when a new coro has been started */	2622	/* the latter happens when a new coro has been started */
2500	/* or when a new cctx was attached to an existing coroutine */	2623	/* or when a new cctx was attached to an existing coroutine */
2501	if (expect_true (!slf_frame.prepare))	2624	if (ecb_expect_true (!slf_frame.prepare))
2502	{	2625	{
2503	/* first iteration */	2626	/* first iteration */
2504	dSP;	2627	dSP;
2505	SV **arg = PL_stack_base + TOPMARK + 1;	2628	SV **arg = PL_stack_base + TOPMARK + 1;
2506	int items = SP - arg; /* args without function object */	2629	int items = SP - arg; /* args without function object */
…		…
2547	while (slf_frame.check (aTHX_ &slf_frame));	2670	while (slf_frame.check (aTHX_ &slf_frame));
2548		2671
2549	slf_frame.prepare = 0; /* invalidate the frame, we are done processing it */	2672	slf_frame.prepare = 0; /* invalidate the frame, we are done processing it */
2550		2673
2551	/* exception handling */	2674	/* exception handling */
2552	if (expect_false (CORO_THROW))	2675	if (ecb_expect_false (CORO_THROW))
2553	{	2676	{
2554	SV *exception = sv_2mortal (CORO_THROW);	2677	SV *exception = sv_2mortal (CORO_THROW);
2555		2678
2556	CORO_THROW = 0;	2679	CORO_THROW = 0;
2557	sv_setsv (ERRSV, exception);	2680	sv_setsv (ERRSV, exception);
2558	croak (0);	2681	croak (0);
2559	}	2682	}
2560		2683
2561	/* return value handling - mostly like entersub */	2684	/* return value handling - mostly like entersub */
2562	/* make sure we put something on the stack in scalar context */	2685	/* make sure we put something on the stack in scalar context */
2563	if (GIMME_V == G_SCALAR)	2686	if (GIMME_V == G_SCALAR
		2687	&& ecb_expect_false (PL_stack_sp != PL_stack_base + checkmark + 1))
2564	{	2688	{
2565	dSP;	2689	dSP;
2566	SV **bot = PL_stack_base + checkmark;	2690	SV **bot = PL_stack_base + checkmark;
2567		2691
2568	if (sp == bot) /* too few, push undef */	2692	if (sp == bot) /* too few, push undef */
2569	bot [1] = &PL_sv_undef;	2693	bot [1] = &PL_sv_undef;
2570	else if (sp != bot + 1) /* too many, take last one */	2694	else /* too many, take last one */
2571	bot [1] = *sp;	2695	bot [1] = *sp;
2572		2696
2573	SP = bot + 1;	2697	SP = bot + 1;
2574		2698
2575	PUTBACK;	2699	PUTBACK;
…		…
2682	{	2806	{
2683	PerlIOBuf base;	2807	PerlIOBuf base;
2684	NV next, every;	2808	NV next, every;
2685	} PerlIOCede;	2809	} PerlIOCede;
2686		2810
2687	static IV	2811	static IV ecb_cold
2688	PerlIOCede_pushed (pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab)	2812	PerlIOCede_pushed (pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab)
2689	{	2813	{
2690	PerlIOCede *self = PerlIOSelf (f, PerlIOCede);	2814	PerlIOCede *self = PerlIOSelf (f, PerlIOCede);
2691		2815
2692	self->every = SvCUR (arg) ? SvNV (arg) : 0.01;	2816	self->every = SvCUR (arg) ? SvNV (arg) : 0.01;
2693	self->next = nvtime () + self->every;	2817	self->next = nvtime () + self->every;
2694		2818
2695	return PerlIOBuf_pushed (aTHX_ f, mode, Nullsv, tab);	2819	return PerlIOBuf_pushed (aTHX_ f, mode, Nullsv, tab);
2696	}	2820	}
2697		2821
2698	static SV *	2822	static SV * ecb_cold
2699	PerlIOCede_getarg (pTHX_ PerlIO *f, CLONE_PARAMS *param, int flags)	2823	PerlIOCede_getarg (pTHX_ PerlIO *f, CLONE_PARAMS *param, int flags)
2700	{	2824	{
2701	PerlIOCede *self = PerlIOSelf (f, PerlIOCede);	2825	PerlIOCede *self = PerlIOSelf (f, PerlIOCede);
2702		2826
2703	return newSVnv (self->every);	2827	return newSVnv (self->every);
…		…
2815	SvREFCNT_dec (cb);	2939	SvREFCNT_dec (cb);
2816	}	2940	}
2817	}	2941	}
2818		2942
2819	static void	2943	static void
2820	coro_semaphore_destroy (pTHX_ struct coro *coro)	2944	coro_semaphore_destroy (pTHX_ struct CoroSLF *frame)
2821	{	2945	{
2822	/* call $sem->adjust (0) to possibly wake up some other waiters */	2946	/* call $sem->adjust (0) to possibly wake up some other waiters */
2823	coro_semaphore_adjust (aTHX_ (AV *)coro->slf_frame.data, 0);	2947	coro_semaphore_adjust (aTHX_ (AV *)frame->data, 0);
2824	}	2948	}
2825		2949
2826	static int	2950	static int
2827	slf_check_semaphore_down_or_wait (pTHX_ struct CoroSLF *frame, int acquire)	2951	slf_check_semaphore_down_or_wait (pTHX_ struct CoroSLF *frame, int acquire)
2828	{	2952	{
2829	AV *av = (AV *)frame->data;	2953	AV *av = (AV *)frame->data;
2830	SV *count_sv = AvARRAY (av)[0];	2954	SV *count_sv = AvARRAY (av)[0];
		2955	SV *coro_hv = SvRV (coro_current);
2831		2956
2832	/* if we are about to throw, don't actually acquire the lock, just throw */	2957	/* if we are about to throw, don't actually acquire the lock, just throw */
2833	if (CORO_THROW)	2958	if (CORO_THROW)
2834	return 0;	2959	return 0;
2835	else if (SvIVX (count_sv) > 0)	2960	else if (SvIVX (count_sv) > 0)
…		…
2847	{	2972	{
2848	int i;	2973	int i;
2849	/* if we were woken up but can't down, we look through the whole */	2974	/* 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 */	2975	/* waiters list and only add us if we aren't in there already */
2851	/* this avoids some degenerate memory usage cases */	2976	/* this avoids some degenerate memory usage cases */
2852		2977	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))	2978	if (AvARRAY (av)[i] == coro_hv)
2855	return 1;	2979	return 1;
2856		2980
2857	av_push (av, SvREFCNT_inc (SvRV (coro_current)));	2981	av_push (av, SvREFCNT_inc (coro_hv));
2858	return 1;	2982	return 1;
2859	}	2983	}
2860	}	2984	}
2861		2985
2862	static int	2986	static int
…		…
3115	dSP;	3239	dSP;
3116		3240
3117	static SV *prio_cv;	3241	static SV *prio_cv;
3118	static SV *prio_sv;	3242	static SV *prio_sv;
3119		3243
3120	if (expect_false (!prio_cv))	3244	if (ecb_expect_false (!prio_cv))
3121	{	3245	{
3122	prio_cv = (SV *)get_cv ("IO::AIO::aioreq_pri", 0);	3246	prio_cv = (SV *)get_cv ("IO::AIO::aioreq_pri", 0);
3123	prio_sv = newSViv (0);	3247	prio_sv = newSViv (0);
3124	}	3248	}
3125		3249
…		…
3231	}	3355	}
3232		3356
3233	return coro_sv;	3357	return coro_sv;
3234	}	3358	}
3235		3359
		3360	#ifndef __cplusplus
		3361	ecb_cold XS(boot_Coro__State);
		3362	#endif
		3363
		3364	#if CORO_JIT
		3365
		3366	static void ecb_noinline ecb_cold
		3367	pushav_4uv (pTHX_ UV a, UV b, UV c, UV d)
		3368	{
		3369	dSP;
		3370	AV *av = newAV ();
		3371
		3372	av_store (av, 3, newSVuv (d));
		3373	av_store (av, 2, newSVuv (c));
		3374	av_store (av, 1, newSVuv (b));
		3375	av_store (av, 0, newSVuv (a));
		3376
		3377	XPUSHs (sv_2mortal (newRV_noinc ((SV *)av)));
		3378
		3379	PUTBACK;
		3380	}
		3381
		3382	static void ecb_noinline ecb_cold
		3383	jit_init (pTHX)
		3384	{
		3385	dSP;
		3386	SV *load, *save;
		3387	char *map_base;
		3388	char *load_ptr, *save_ptr;
		3389	STRLEN load_len, save_len, map_len;
		3390	int count;
		3391
		3392	eval_pv ("require 'Coro/jit-" CORO_JIT_TYPE ".pl'", 1);
		3393
		3394	PUSHMARK (SP);
		3395	#define VARx(name,expr,type) pushav_4uv (aTHX_ (UV)&(expr), sizeof (expr), offsetof (perl_slots, name), sizeof (type));
		3396	# include "state.h"
		3397	#undef VARx
		3398	count = call_pv ("Coro::State::_jit", G_ARRAY);
		3399	SPAGAIN;
		3400
		3401	save = POPs; save_ptr = SvPVbyte (save, save_len);
		3402	load = POPs; load_ptr = SvPVbyte (load, load_len);
		3403
		3404	map_len = load_len + save_len + 16;
		3405
		3406	map_base = mmap (0, map_len, PROT_READ | PROT_WRITE | PROT_EXEC, MAP_PRIVATE | MAP_ANONYMOUS, -1, 0);
		3407
		3408	assert (("Coro: unable to mmap jit code page, cannot continue.", map_base != (char *)MAP_FAILED));
		3409
		3410	load_perl_slots = (load_save_perl_slots_type)map_base;
		3411	memcpy (map_base, load_ptr, load_len);
		3412
		3413	map_base += (load_len + 15) & ~15;
		3414
		3415	save_perl_slots = (load_save_perl_slots_type)map_base;
		3416	memcpy (map_base, save_ptr, save_len);
		3417
		3418	/* we are good citizens and try to make the page read-only, so the evil evil */
		3419	/* hackers might have it a bit more difficult */
		3420	mprotect (map_base, map_len, PROT_READ | PROT_EXEC);
		3421
		3422	PUTBACK;
		3423	eval_pv ("undef &Coro::State::_jit", 1);
		3424	}
		3425
		3426	#endif
		3427
3236	MODULE = Coro::State PACKAGE = Coro::State PREFIX = api_	3428	MODULE = Coro::State PACKAGE = Coro::State PREFIX = api_
3237		3429
3238	PROTOTYPES: DISABLE	3430	PROTOTYPES: DISABLE
3239		3431
3240	BOOT:	3432	BOOT:
…		…
3243	# if CORO_PTHREAD	3435	# if CORO_PTHREAD
3244	coro_thx = PERL_GET_CONTEXT;	3436	coro_thx = PERL_GET_CONTEXT;
3245	# endif	3437	# endif
3246	#endif	3438	#endif
3247	BOOT_PAGESIZE;	3439	BOOT_PAGESIZE;
		3440
		3441	/* perl defines these to check for existance first, but why it doesn't */
		3442	/* just create them one at init time is not clear to me, except for */
		3443	/* programs trying to delete them, but... */
		3444	/* anyway, we declare this as invalid and make sure they are initialised here */
		3445	DEFSV;
		3446	ERRSV;
3248		3447
3249	cctx_current = cctx_new_empty ();	3448	cctx_current = cctx_new_empty ();
3250		3449
3251	irsgv = gv_fetchpv ("/" , GV_ADD|GV_NOTQUAL, SVt_PV);	3450	irsgv = gv_fetchpv ("/" , GV_ADD|GV_NOTQUAL, SVt_PV);
3252	stdoutgv = gv_fetchpv ("STDOUT", GV_ADD|GV_NOTQUAL, SVt_PVIO);	3451	stdoutgv = gv_fetchpv ("STDOUT", GV_ADD|GV_NOTQUAL, SVt_PVIO);
…		…
3295	coroapi.prepare_cede_notself = prepare_cede_notself;	3494	coroapi.prepare_cede_notself = prepare_cede_notself;
3296		3495
3297	time_init (aTHX);	3496	time_init (aTHX);
3298		3497
3299	assert (("PRIO_NORMAL must be 0", !CORO_PRIO_NORMAL));	3498	assert (("PRIO_NORMAL must be 0", !CORO_PRIO_NORMAL));
		3499	#if CORO_JIT
		3500	PUTBACK;
		3501	jit_init (aTHX);
		3502	SPAGAIN;
		3503	#endif
3300	}	3504	}
3301		3505
3302	SV *	3506	SV *
3303	new (SV *klass, ...)	3507	new (SV *klass, ...)
3304	ALIAS:	3508	ALIAS:
…		…
3446	PROTOTYPE: $	3650	PROTOTYPE: $
3447	ALIAS:	3651	ALIAS:
3448	is_ready = CF_READY	3652	is_ready = CF_READY
3449	is_running = CF_RUNNING	3653	is_running = CF_RUNNING
3450	is_new = CF_NEW	3654	is_new = CF_NEW
3451	is_destroyed = CF_DESTROYED	3655	is_destroyed = CF_ZOMBIE
		3656	is_zombie = CF_ZOMBIE
3452	is_suspended = CF_SUSPENDED	3657	is_suspended = CF_SUSPENDED
3453	CODE:	3658	CODE:
3454	RETVAL = boolSV (coro->flags & ix);	3659	RETVAL = boolSV (coro->flags & ix);
3455	OUTPUT:	3660	OUTPUT:
3456	RETVAL	3661	RETVAL
…		…
3551	times (Coro::State self)	3756	times (Coro::State self)
3552	PPCODE:	3757	PPCODE:
3553	{	3758	{
3554	struct coro *current = SvSTATE (coro_current);	3759	struct coro *current = SvSTATE (coro_current);
3555		3760
3556	if (expect_false (current == self))	3761	if (ecb_expect_false (current == self))
3557	{	3762	{
3558	coro_times_update ();	3763	coro_times_update ();
3559	coro_times_add (SvSTATE (coro_current));	3764	coro_times_add (SvSTATE (coro_current));
3560	}	3765	}
3561		3766
3562	EXTEND (SP, 2);	3767	EXTEND (SP, 2);
3563	PUSHs (sv_2mortal (newSVnv (self->t_real [0] + self->t_real [1] * 1e-9)));	3768	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)));	3769	PUSHs (sv_2mortal (newSVnv (self->t_cpu [0] + self->t_cpu [1] * 1e-9)));
3565		3770
3566	if (expect_false (current == self))	3771	if (ecb_expect_false (current == self))
3567	coro_times_sub (SvSTATE (coro_current));	3772	coro_times_sub (SvSTATE (coro_current));
3568	}	3773	}
3569		3774
3570	void	3775	void
3571	swap_sv (Coro::State coro, SV *sv, SV *swapsv)	3776	swap_sv (Coro::State coro, SV *sv, SV *swapsv)
…		…
3644	void	3849	void
3645	_destroy (Coro::State coro)	3850	_destroy (Coro::State coro)
3646	CODE:	3851	CODE:
3647	/* used by the manager thread */	3852	/* used by the manager thread */
3648	coro_state_destroy (aTHX_ coro);	3853	coro_state_destroy (aTHX_ coro);
		3854
		3855	void
		3856	on_destroy (Coro::State coro, SV *cb)
		3857	CODE:
3649	coro_call_on_destroy (aTHX_ coro);	3858	coro_push_on_destroy (aTHX_ coro, newSVsv (cb));
		3859
		3860	void
		3861	join (...)
		3862	CODE:
		3863	CORO_EXECUTE_SLF_XS (slf_init_join);
3650		3864
3651	void	3865	void
3652	terminate (...)	3866	terminate (...)
3653	CODE:	3867	CODE:
3654	CORO_EXECUTE_SLF_XS (slf_init_terminate);	3868	CORO_EXECUTE_SLF_XS (slf_init_terminate);
…		…
3944	}	4158	}
3945		4159
3946	MODULE = Coro::State PACKAGE = Coro::SemaphoreSet	4160	MODULE = Coro::State PACKAGE = Coro::SemaphoreSet
3947		4161
3948	void	4162	void
3949	_may_delete (SV *sem, int count, int extra_refs)	4163	_may_delete (SV *sem, int count, unsigned int extra_refs)
3950	PPCODE:	4164	PPCODE:
3951	{	4165	{
3952	AV *av = (AV *)SvRV (sem);	4166	AV *av = (AV *)SvRV (sem);
3953		4167
3954	if (SvREFCNT ((SV *)av) == 1 + extra_refs	4168	if (SvREFCNT ((SV *)av) == 1 + extra_refs

Diff Legend

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