ViewVC Help

View File | Revision Log | Show Annotations | Download File

/cvs/Coro/Coro/State.xs

Comparing Coro/Coro/State.xs (file contents):
Revision 1.332 by root, Thu Nov 27 12:20:31 2008 UTC vs.
Revision 1.434 by root, Sat Nov 2 19:48:50 2013 UTC

		1	/* this works around a bug in mingw32 providing a non-working setjmp */
		2	#define USE_NO_MINGW_SETJMP_TWO_ARGS
		3
		4	#define NDEBUG 1 /* perl usually disables NDEBUG later */
		5
1	#include "libcoro/coro.c"	6	#include "libcoro/coro.c"
2		7
3	#define PERL_NO_GET_CONTEXT	8	#define PERL_NO_GET_CONTEXT
4	#define PERL_EXT	9	#define PERL_EXT
5		10
6	#include "EXTERN.h"	11	#include "EXTERN.h"
7	#include "perl.h"	12	#include "perl.h"
8	#include "XSUB.h"	13	#include "XSUB.h"
9	#include "perliol.h"	14	#include "perliol.h"
10		15
11	#include "patchlevel.h"	16	#include "schmorp.h"
12		17
		18	#define ECB_NO_THREADS 1
		19	#include "ecb.h"
		20
		21	#include <stddef.h>
13	#include <stdio.h>	22	#include <stdio.h>
14	#include <errno.h>	23	#include <errno.h>
15	#include <assert.h>	24	#include <assert.h>
16		25
17	#ifdef WIN32	26	#ifndef SVs_PADSTALE
		27	# define SVs_PADSTALE 0
		28	#endif
		29
		30	#ifdef PadARRAY
		31	# define NEWPADAPI 1
		32	# define newPADLIST(var) (Newz (0, var, 1, PADLIST), Newx (PadlistARRAY (var), 2, PAD *))
		33	#else
		34	typedef AV PADNAMELIST;
		35	# if !PERL_VERSION_ATLEAST(5,8,0)
		36	typedef AV PADLIST;
		37	typedef AV PAD;
		38	# endif
		39	# define PadlistARRAY(pl) ((PAD **)AvARRAY (pl))
		40	# define PadlistMAX(pl) AvFILLp (pl)
		41	# define PadlistNAMES(pl) (*PadlistARRAY (pl))
		42	# define PadARRAY AvARRAY
		43	# define PadMAX AvFILLp
		44	# define newPADLIST(var) ((var) = newAV (), av_extend (var, 1))
		45	#endif
		46
		47	#if defined(_WIN32)
		48	# undef HAS_GETTIMEOFDAY
18	# undef setjmp	49	# undef setjmp
19	# undef longjmp	50	# undef longjmp
20	# undef _exit	51	# undef _exit
21	# define setjmp _setjmp /* deep magic */	52	# define setjmp _setjmp /* deep magic */
22	#else	53	#else
23	# include <inttypes.h> /* most portable stdint.h */	54	# include <inttypes.h> /* most portable stdint.h */
24	#endif	55	#endif
25		56
26	#ifdef HAVE_MMAP
27	# include <unistd.h>
28	# include <sys/mman.h>
29	# ifndef MAP_ANONYMOUS
30	# ifdef MAP_ANON
31	# define MAP_ANONYMOUS MAP_ANON
32	# else
33	# undef HAVE_MMAP
34	# endif
35	# endif
36	# include <limits.h>
37	# ifndef PAGESIZE
38	# define PAGESIZE pagesize
39	# define BOOT_PAGESIZE pagesize = sysconf (_SC_PAGESIZE)
40	static long pagesize;
41	# else
42	# define BOOT_PAGESIZE (void)0
43	# endif
44	#else
45	# define PAGESIZE 0
46	# define BOOT_PAGESIZE (void)0
47	#endif
48
49	#if CORO_USE_VALGRIND
50	# include <valgrind/valgrind.h>
51	#endif
52
53	/* the maximum number of idle cctx that will be pooled */	57	/* the maximum number of idle cctx that will be pooled */
54	static int cctx_max_idle = 4;	58	static int cctx_max_idle = 4;
55		59
56	#define PERL_VERSION_ATLEAST(a,b,c) \	60	#if defined(DEBUGGING) && PERL_VERSION_ATLEAST(5,12,0)
57	(PERL_REVISION > (a) \	61	# define HAS_SCOPESTACK_NAME 1
58	|| (PERL_REVISION == (a) \
59	&& (PERL_VERSION > (b) \
60	|| (PERL_VERSION == (b) && PERL_SUBVERSION >= (c)))))
61
62	#if !PERL_VERSION_ATLEAST (5,6,0)
63	# ifndef PL_ppaddr
64	# define PL_ppaddr ppaddr
65	# endif
66	# ifndef call_sv
67	# define call_sv perl_call_sv
68	# endif
69	# ifndef get_sv
70	# define get_sv perl_get_sv
71	# endif
72	# ifndef get_cv
73	# define get_cv perl_get_cv
74	# endif
75	# ifndef IS_PADGV
76	# define IS_PADGV(v) 0
77	# endif
78	# ifndef IS_PADCONST
79	# define IS_PADCONST(v) 0
80	# endif
81	#endif
82
83	/* 5.11 */
84	#ifndef CxHASARGS
85	# define CxHASARGS(cx) (cx)->blk_sub.hasargs
86	#endif
87
88	/* 5.10.0 */
89	#ifndef SvREFCNT_inc_NN
90	# define SvREFCNT_inc_NN(sv) SvREFCNT_inc (sv)
91	#endif
92
93	/* 5.8.8 */
94	#ifndef GV_NOTQUAL
95	# define GV_NOTQUAL 0
96	#endif
97	#ifndef newSV
98	# define newSV(l) NEWSV(0,l)
99	#endif
100	#ifndef CvISXSUB_on
101	# define CvISXSUB_on(cv) (void)cv
102	#endif
103	#ifndef CvISXSUB
104	# define CvISXSUB(cv) (CvXSUB (cv) ? TRUE : FALSE)
105	#endif
106	#ifndef Newx
107	# define Newx(ptr,nitems,type) New (0,ptr,nitems,type)
108	#endif
109
110	/* 5.8.7 */
111	#ifndef SvRV_set
112	# define SvRV_set(s,v) SvRV(s) = (v)
113	#endif
114
115	#if !__i386 && !__x86_64 && !__powerpc && !__m68k && !__alpha && !__mips && !__sparc64
116	# undef CORO_STACKGUARD
117	#endif
118
119	#ifndef CORO_STACKGUARD
120	# define CORO_STACKGUARD 0
121	#endif	62	#endif
122		63
123	/* prefer perl internal functions over our own? */	64	/* prefer perl internal functions over our own? */
124	#ifndef CORO_PREFER_PERL_FUNCTIONS	65	#ifndef CORO_PREFER_PERL_FUNCTIONS
125	# define CORO_PREFER_PERL_FUNCTIONS 0	66	# define CORO_PREFER_PERL_FUNCTIONS 0
…		…
135	# define STACKLEVEL ((void *)&stacklevel)	76	# define STACKLEVEL ((void *)&stacklevel)
136	#endif	77	#endif
137		78
138	#define IN_DESTRUCT PL_dirty	79	#define IN_DESTRUCT PL_dirty
139		80
140	#if __GNUC__ >= 3
141	# define attribute(x) __attribute__(x)
142	# define expect(expr,value) __builtin_expect ((expr),(value))
143	# define INLINE static inline
144	#else
145	# define attribute(x)
146	# define expect(expr,value) (expr)
147	# define INLINE static
148	#endif
149
150	#define expect_false(expr) expect ((expr) != 0, 0)
151	#define expect_true(expr) expect ((expr) != 0, 1)
152
153	#define NOINLINE attribute ((noinline))
154
155	#include "CoroAPI.h"	81	#include "CoroAPI.h"
156	#define GCoroAPI (&coroapi) /* very sneaky */	82	#define GCoroAPI (&coroapi) /* very sneaky */
157		83
158	#ifdef USE_ITHREADS	84	#ifdef USE_ITHREADS
159	# if CORO_PTHREAD	85	# if CORO_PTHREAD
160	static void *coro_thx;	86	static void *coro_thx;
161	# endif	87	# endif
162	#endif	88	#endif
163		89
		90	#ifdef __linux
		91	# include <time.h> /* for timespec */
		92	# include <syscall.h> /* for SYS_* */
		93	# ifdef SYS_clock_gettime
		94	# define coro_clock_gettime(id, ts) syscall (SYS_clock_gettime, (id), (ts))
		95	# define CORO_CLOCK_MONOTONIC 1
		96	# define CORO_CLOCK_THREAD_CPUTIME_ID 3
		97	# endif
		98	#endif
		99
164	static double (*nvtime)(); /* so why doesn't it take void? */	100	static double (*nvtime)(); /* so why doesn't it take void? */
		101	static void (*u2time)(pTHX_ UV ret[2]);
165		102
166	/* we hijack an hopefully unused CV flag for our purposes */	103	/* we hijack an hopefully unused CV flag for our purposes */
167	#define CVf_SLF 0x4000	104	#define CVf_SLF 0x4000
168	static OP *pp_slf (pTHX);	105	static OP *pp_slf (pTHX);
		106	static void slf_destroy (pTHX_ struct coro *coro);
169		107
170	static U32 cctx_gen;	108	static U32 cctx_gen;
171	static size_t cctx_stacksize = CORO_STACKSIZE;	109	static size_t cctx_stacksize = CORO_STACKSIZE;
172	static struct CoroAPI coroapi;	110	static struct CoroAPI coroapi;
173	static AV *main_mainstack; /* used to differentiate between $main and others */	111	static AV *main_mainstack; /* used to differentiate between $main and others */
…		…
190	static SV *sv_pool_size;	128	static SV *sv_pool_size;
191	static SV *sv_async_pool_idle; /* description string */	129	static SV *sv_async_pool_idle; /* description string */
192	static AV *av_async_pool; /* idle pool */	130	static AV *av_async_pool; /* idle pool */
193	static SV *sv_Coro; /* class string */	131	static SV *sv_Coro; /* class string */
194	static CV *cv_pool_handler;	132	static CV *cv_pool_handler;
195	static CV *cv_coro_state_new;
196		133
197	/* Coro::AnyEvent */	134	/* Coro::AnyEvent */
198	static SV *sv_activity;	135	static SV *sv_activity;
199		136
		137	/* enable processtime/realtime profiling */
		138	static char enable_times;
		139	typedef U32 coro_ts[2];
		140	static coro_ts time_real, time_cpu;
		141	static char times_valid;
		142
200	static struct coro_cctx *cctx_first;	143	static struct coro_cctx *cctx_first;
201	static int cctx_count, cctx_idle;	144	static int cctx_count, cctx_idle;
202		145
203	enum {	146	enum
		147	{
204	CC_MAPPED = 0x01,	148	CC_MAPPED = 0x01,
205	CC_NOREUSE = 0x02, /* throw this away after tracing */	149	CC_NOREUSE = 0x02, /* throw this away after tracing */
206	CC_TRACE = 0x04,	150	CC_TRACE = 0x04,
207	CC_TRACE_SUB = 0x08, /* trace sub calls */	151	CC_TRACE_SUB = 0x08, /* trace sub calls */
208	CC_TRACE_LINE = 0x10, /* trace each statement */	152	CC_TRACE_LINE = 0x10, /* trace each statement */
…		…
213	typedef struct coro_cctx	157	typedef struct coro_cctx
214	{	158	{
215	struct coro_cctx *next;	159	struct coro_cctx *next;
216		160
217	/* the stack */	161	/* the stack */
218	void *sptr;	162	struct coro_stack stack;
219	size_t ssize;
220		163
221	/* cpu state */	164	/* cpu state */
222	void *idle_sp; /* sp of top-level transfer/schedule/cede call */	165	void *idle_sp; /* sp of top-level transfer/schedule/cede call */
		166	#ifndef NDEBUG
223	JMPENV *idle_te; /* same as idle_sp, but for top_env, TODO: remove once stable */	167	JMPENV *idle_te; /* same as idle_sp, but for top_env */
		168	#endif
224	JMPENV *top_env;	169	JMPENV *top_env;
225	coro_context cctx;	170	coro_context cctx;
226		171
227	U32 gen;	172	U32 gen;
228	#if CORO_USE_VALGRIND	173	#if CORO_USE_VALGRIND
229	int valgrind_id;	174	int valgrind_id;
230	#endif	175	#endif
231	unsigned char flags;	176	unsigned char flags;
232	} coro_cctx;	177	} coro_cctx;
233		178
234	coro_cctx *cctx_current; /* the currently running cctx */	179	static coro_cctx *cctx_current; /* the currently running cctx */
235		180
236	/*****************************************************************************/	181	/*****************************************************************************/
237		182
		183	static MGVTBL coro_state_vtbl;
		184
238	enum {	185	enum
		186	{
239	CF_RUNNING = 0x0001, /* coroutine is running */	187	CF_RUNNING = 0x0001, /* coroutine is running */
240	CF_READY = 0x0002, /* coroutine is ready */	188	CF_READY = 0x0002, /* coroutine is ready */
241	CF_NEW = 0x0004, /* has never been switched to */	189	CF_NEW = 0x0004, /* has never been switched to */
242	CF_DESTROYED = 0x0008, /* coroutine data has been freed */	190	CF_ZOMBIE = 0x0008, /* coroutine data has been freed */
		191	CF_SUSPENDED = 0x0010, /* coroutine can't be scheduled */
		192	CF_NOCANCEL = 0x0020, /* cannot cancel, set slf_frame.data to 1 (hackish) */
243	};	193	};
244		194
245	/* the structure where most of the perl state is stored, overlaid on the cxstack */	195	/* the structure where most of the perl state is stored, overlaid on the cxstack */
246	typedef struct	196	typedef struct
247	{	197	{
248	SV *defsv;
249	AV *defav;
250	SV *errsv;
251	SV *irsgv;
252	HV *hinthv;
253	#define VAR(name,type) type name;	198	#define VARx(name,expr,type) type name;
254	# include "state.h"	199	#include "state.h"
255	#undef VAR
256	} perl_slots;	200	} perl_slots;
257		201
		202	/* how many context stack entries do we need for perl_slots */
258	#define SLOT_COUNT ((sizeof (perl_slots) + sizeof (PERL_CONTEXT) - 1) / sizeof (PERL_CONTEXT))	203	#define SLOT_COUNT ((sizeof (perl_slots) + sizeof (PERL_CONTEXT) - 1) / sizeof (PERL_CONTEXT))
259		204
260	/* this is a structure representing a perl-level coroutine */	205	/* this is a structure representing a perl-level coroutine */
261	struct coro {	206	struct coro
		207	{
262	/* the C coroutine allocated to this perl coroutine, if any */	208	/* the C coroutine allocated to this perl coroutine, if any */
263	coro_cctx *cctx;	209	coro_cctx *cctx;
		210
		211	/* ready queue */
		212	struct coro *next_ready;
264		213
265	/* state data */	214	/* state data */
266	struct CoroSLF slf_frame; /* saved slf frame */	215	struct CoroSLF slf_frame; /* saved slf frame */
267	AV *mainstack;	216	AV *mainstack;
268	perl_slots *slot; /* basically the saved sp */	217	perl_slots *slot; /* basically the saved sp */
269		218
270	CV *startcv; /* the CV to execute */	219	CV *startcv; /* the CV to execute */
271	AV *args; /* data associated with this coroutine (initial args) */	220	AV *args; /* data associated with this coroutine (initial args) */
272	int refcnt; /* coroutines are refcounted, yes */
273	int flags; /* CF_ flags */	221	int flags; /* CF_ flags */
274	HV *hv; /* the perl hash associated with this coro, if any */	222	HV *hv; /* the perl hash associated with this coro, if any */
275	void (*on_destroy)(pTHX_ struct coro *coro);
276		223
277	/* statistics */	224	/* statistics */
278	int usecount; /* number of transfers to this coro */	225	int usecount; /* number of transfers to this coro */
279		226
280	/* coro process data */	227	/* coro process data */
281	int prio;	228	int prio;
282	SV *except; /* exception to be thrown */	229	SV *except; /* exception to be thrown */
283	SV *rouse_cb;	230	SV *rouse_cb; /* last rouse callback */
		231	AV *on_destroy; /* callbacks or coros to notify on destroy */
		232	AV *status; /* the exit status list */
284		233
285	/* async_pool */	234	/* async_pool */
286	SV *saved_deffh;	235	SV *saved_deffh;
287	SV *invoke_cb;	236	SV *invoke_cb;
288	AV *invoke_av;	237	AV *invoke_av;
289		238
		239	/* on_enter/on_leave */
		240	AV *on_enter;
		241	AV *on_leave;
		242
		243	/* swap_sv */
		244	AV *swap_sv;
		245
		246	/* times */
		247	coro_ts t_cpu, t_real;
		248
290	/* linked list */	249	/* linked list */
291	struct coro *next, *prev;	250	struct coro *next, *prev;
292	};	251	};
293		252
294	typedef struct coro *Coro__State;	253	typedef struct coro *Coro__State;
295	typedef struct coro *Coro__State_or_hashref;	254	typedef struct coro *Coro__State_or_hashref;
296		255
297	/* the following variables are effectively part of the perl context */	256	/* the following variables are effectively part of the perl context */
298	/* and get copied between struct coro and these variables */	257	/* and get copied between struct coro and these variables */
299	/* the mainr easonw e don't support windows process emulation */	258	/* the main reason we don't support windows process emulation */
300	static struct CoroSLF slf_frame; /* the current slf frame */	259	static struct CoroSLF slf_frame; /* the current slf frame */
301		260
302	/** Coro ********************************************************************/	261	/** Coro ********************************************************************/
303		262
304	#define PRIO_MAX 3	263	#define CORO_PRIO_MAX 3
305	#define PRIO_HIGH 1	264	#define CORO_PRIO_HIGH 1
306	#define PRIO_NORMAL 0	265	#define CORO_PRIO_NORMAL 0
307	#define PRIO_LOW -1	266	#define CORO_PRIO_LOW -1
308	#define PRIO_IDLE -3	267	#define CORO_PRIO_IDLE -3
309	#define PRIO_MIN -4	268	#define CORO_PRIO_MIN -4
310		269
311	/* for Coro.pm */	270	/* for Coro.pm */
312	static SV *coro_current;	271	static SV *coro_current;
313	static SV *coro_readyhook;	272	static SV *coro_readyhook;
314	static AV *coro_ready [PRIO_MAX - PRIO_MIN + 1];	273	static struct coro *coro_ready [CORO_PRIO_MAX - CORO_PRIO_MIN + 1][2]; /* head|tail */
315	static CV *cv_coro_run, *cv_coro_terminate;	274	static CV *cv_coro_run;
316	static struct coro *coro_first;	275	static struct coro *coro_first;
317	#define coro_nready coroapi.nready	276	#define coro_nready coroapi.nready
318		277
		278	/** JIT *********************************************************************/
		279
		280	#if CORO_JIT
		281	/* APPLE doesn't have mmap though */
		282	#define CORO_JIT_UNIXY (__linux || __FreeBSD__ || __OpenBSD__ || __NetBSD__ || __solaris || __APPLE__)
		283	#ifndef CORO_JIT_TYPE
		284	#if ECB_AMD64 && CORO_JIT_UNIXY
		285	#define CORO_JIT_TYPE "amd64-unix"
		286	#elif __i386 && CORO_JIT_UNIXY
		287	#define CORO_JIT_TYPE "x86-unix"
		288	#endif
		289	#endif
		290	#endif
		291
		292	#if !defined(CORO_JIT_TYPE) || _POSIX_MEMORY_PROTECTION <= 0
		293	#undef CORO_JIT
		294	#endif
		295
		296	#if CORO_JIT
		297	typedef void (*load_save_perl_slots_type)(perl_slots *);
		298	static load_save_perl_slots_type load_perl_slots, save_perl_slots;
		299	#endif
		300
		301	/** Coro::Select ************************************************************/
		302
		303	static OP *(*coro_old_pp_sselect) (pTHX);
		304	static SV *coro_select_select;
		305
		306	/* horrible hack, but if it works... */
		307	static OP *
		308	coro_pp_sselect (pTHX)
		309	{
		310	dSP;
		311	PUSHMARK (SP - 4); /* fake argument list */
		312	XPUSHs (coro_select_select);
		313	PUTBACK;
		314
		315	/* entersub is an UNOP, select a LISTOP... keep your fingers crossed */
		316	PL_op->op_flags |= OPf_STACKED;
		317	PL_op->op_private = 0;
		318	return PL_ppaddr [OP_ENTERSUB](aTHX);
		319	}
		320
		321	/** time stuff **************************************************************/
		322
		323	#ifdef HAS_GETTIMEOFDAY
		324
		325	ecb_inline void
		326	coro_u2time (pTHX_ UV ret[2])
		327	{
		328	struct timeval tv;
		329	gettimeofday (&tv, 0);
		330
		331	ret [0] = tv.tv_sec;
		332	ret [1] = tv.tv_usec;
		333	}
		334
		335	ecb_inline double
		336	coro_nvtime (void)
		337	{
		338	struct timeval tv;
		339	gettimeofday (&tv, 0);
		340
		341	return tv.tv_sec + tv.tv_usec * 1e-6;
		342	}
		343
		344	ecb_inline void
		345	time_init (pTHX)
		346	{
		347	nvtime = coro_nvtime;
		348	u2time = coro_u2time;
		349	}
		350
		351	#else
		352
		353	ecb_inline void
		354	time_init (pTHX)
		355	{
		356	SV **svp;
		357
		358	require_pv ("Time/HiRes.pm");
		359
		360	svp = hv_fetch (PL_modglobal, "Time::NVtime", 12, 0);
		361
		362	if (!svp) croak ("Time::HiRes is required, but missing. Caught");
		363	if (!SvIOK (*svp)) croak ("Time::NVtime isn't a function pointer. Caught");
		364
		365	nvtime = INT2PTR (double (*)(), SvIV (*svp));
		366
		367	svp = hv_fetch (PL_modglobal, "Time::U2time", 12, 0);
		368	u2time = INT2PTR (void (*)(pTHX_ UV ret[2]), SvIV (*svp));
		369	}
		370
		371	#endif
		372
319	/** lowlevel stuff **********************************************************/	373	/** lowlevel stuff **********************************************************/
320		374
321	static SV *	375	static SV * ecb_noinline
322	coro_get_sv (pTHX_ const char *name, int create)	376	coro_get_sv (pTHX_ const char *name, int create)
323	{	377	{
324	#if PERL_VERSION_ATLEAST (5,10,0)	378	#if PERL_VERSION_ATLEAST (5,10,0)
325	/* silence stupid and wrong 5.10 warning that I am unable to switch off */	379	/* silence stupid and wrong 5.10 warning that I am unable to switch off */
326	get_sv (name, create);	380	get_sv (name, create);
327	#endif	381	#endif
328	return get_sv (name, create);	382	return get_sv (name, create);
329	}	383	}
330		384
331	static AV *	385	static AV * ecb_noinline
332	coro_get_av (pTHX_ const char *name, int create)	386	coro_get_av (pTHX_ const char *name, int create)
333	{	387	{
334	#if PERL_VERSION_ATLEAST (5,10,0)	388	#if PERL_VERSION_ATLEAST (5,10,0)
335	/* silence stupid and wrong 5.10 warning that I am unable to switch off */	389	/* silence stupid and wrong 5.10 warning that I am unable to switch off */
336	get_av (name, create);	390	get_av (name, create);
337	#endif	391	#endif
338	return get_av (name, create);	392	return get_av (name, create);
339	}	393	}
340		394
341	static HV *	395	static HV * ecb_noinline
342	coro_get_hv (pTHX_ const char *name, int create)	396	coro_get_hv (pTHX_ const char *name, int create)
343	{	397	{
344	#if PERL_VERSION_ATLEAST (5,10,0)	398	#if PERL_VERSION_ATLEAST (5,10,0)
345	/* silence stupid and wrong 5.10 warning that I am unable to switch off */	399	/* silence stupid and wrong 5.10 warning that I am unable to switch off */
346	get_hv (name, create);	400	get_hv (name, create);
347	#endif	401	#endif
348	return get_hv (name, create);	402	return get_hv (name, create);
349	}	403	}
350		404
351	/* may croak */	405	ecb_inline void
352	INLINE CV *	406	coro_times_update (void)
353	coro_sv_2cv (pTHX_ SV *sv)
354	{	407	{
355	HV *st;	408	#ifdef coro_clock_gettime
356	GV *gvp;	409	struct timespec ts;
357	return sv_2cv (sv, &st, &gvp, 0);	410
		411	ts.tv_sec = ts.tv_nsec = 0;
		412	coro_clock_gettime (CORO_CLOCK_THREAD_CPUTIME_ID, &ts);
		413	time_cpu [0] = ts.tv_sec; time_cpu [1] = ts.tv_nsec;
		414
		415	ts.tv_sec = ts.tv_nsec = 0;
		416	coro_clock_gettime (CORO_CLOCK_MONOTONIC, &ts);
		417	time_real [0] = ts.tv_sec; time_real [1] = ts.tv_nsec;
		418	#else
		419	dTHX;
		420	UV tv[2];
		421
		422	u2time (aTHX_ tv);
		423	time_real [0] = tv [0];
		424	time_real [1] = tv [1] * 1000;
		425	#endif
		426	}
		427
		428	ecb_inline void
		429	coro_times_add (struct coro *c)
		430	{
		431	c->t_real [1] += time_real [1];
		432	if (c->t_real [1] > 1000000000) { c->t_real [1] -= 1000000000; ++c->t_real [0]; }
		433	c->t_real [0] += time_real [0];
		434
		435	c->t_cpu [1] += time_cpu [1];
		436	if (c->t_cpu [1] > 1000000000) { c->t_cpu [1] -= 1000000000; ++c->t_cpu [0]; }
		437	c->t_cpu [0] += time_cpu [0];
		438	}
		439
		440	ecb_inline void
		441	coro_times_sub (struct coro *c)
		442	{
		443	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];
		445	c->t_real [0] -= time_real [0];
		446
		447	if (c->t_cpu [1] < time_cpu [1]) { c->t_cpu [1] += 1000000000; --c->t_cpu [0]; }
		448	c->t_cpu [1] -= time_cpu [1];
		449	c->t_cpu [0] -= time_cpu [0];
358	}	450	}
359		451
360	/*****************************************************************************/	452	/*****************************************************************************/
361	/* magic glue */	453	/* magic glue */
362		454
363	#define CORO_MAGIC_type_cv 26	455	#define CORO_MAGIC_type_cv 26
364	#define CORO_MAGIC_type_state PERL_MAGIC_ext	456	#define CORO_MAGIC_type_state PERL_MAGIC_ext
365		457
366	#define CORO_MAGIC_NN(sv, type) \	458	#define CORO_MAGIC_NN(sv, type) \
367	(expect_true (SvMAGIC (sv)->mg_type == type) \	459	(ecb_expect_true (SvMAGIC (sv)->mg_type == type) \
368	? SvMAGIC (sv) \	460	? SvMAGIC (sv) \
369	: mg_find (sv, type))	461	: mg_find (sv, type))
370		462
371	#define CORO_MAGIC(sv, type) \	463	#define CORO_MAGIC(sv, type) \
372	(expect_true (SvMAGIC (sv)) \	464	(ecb_expect_true (SvMAGIC (sv)) \
373	? CORO_MAGIC_NN (sv, type) \	465	? CORO_MAGIC_NN (sv, type) \
374	: 0)	466	: 0)
375		467
376	#define CORO_MAGIC_cv(cv) CORO_MAGIC (((SV *)(cv)), CORO_MAGIC_type_cv)	468	#define CORO_MAGIC_cv(cv) CORO_MAGIC (((SV *)(cv)), CORO_MAGIC_type_cv)
377	#define CORO_MAGIC_state(sv) CORO_MAGIC_NN (((SV *)(sv)), CORO_MAGIC_type_state)	469	#define CORO_MAGIC_state(sv) CORO_MAGIC_NN (((SV *)(sv)), CORO_MAGIC_type_state)
378		470
379	INLINE struct coro *	471	ecb_inline MAGIC *
		472	SvSTATEhv_p (pTHX_ SV *coro)
		473	{
		474	MAGIC *mg;
		475
		476	if (ecb_expect_true (
		477	SvTYPE (coro) == SVt_PVHV
		478	&& (mg = CORO_MAGIC_state (coro))
		479	&& mg->mg_virtual == &coro_state_vtbl
		480	))
		481	return mg;
		482
		483	return 0;
		484	}
		485
		486	ecb_inline struct coro *
380	SvSTATE_ (pTHX_ SV *coro)	487	SvSTATE_ (pTHX_ SV *coro)
381	{	488	{
382	HV *stash;
383	MAGIC *mg;	489	MAGIC *mg;
384		490
385	if (SvROK (coro))	491	if (SvROK (coro))
386	coro = SvRV (coro);	492	coro = SvRV (coro);
387		493
388	if (expect_false (SvTYPE (coro) != SVt_PVHV))	494	mg = SvSTATEhv_p (aTHX_ coro);
		495	if (!mg)
389	croak ("Coro::State object required");	496	croak ("Coro::State object required");
390		497
391	stash = SvSTASH (coro);
392	if (expect_false (stash != coro_stash && stash != coro_state_stash))
393	{
394	/* very slow, but rare, check */
395	if (!sv_derived_from (sv_2mortal (newRV_inc (coro)), "Coro::State"))
396	croak ("Coro::State object required");
397	}
398
399	mg = CORO_MAGIC_state (coro);
400	return (struct coro *)mg->mg_ptr;	498	return (struct coro *)mg->mg_ptr;
401	}	499	}
402		500
403	#define SvSTATE(sv) SvSTATE_ (aTHX_ (sv))	501	#define SvSTATE(sv) SvSTATE_ (aTHX_ (sv))
404		502
…		…
407	#define SvSTATE_current SvSTATE_hv (SvRV (coro_current))	505	#define SvSTATE_current SvSTATE_hv (SvRV (coro_current))
408		506
409	/*****************************************************************************/	507	/*****************************************************************************/
410	/* padlist management and caching */	508	/* padlist management and caching */
411		509
412	static AV *	510	ecb_inline PADLIST *
413	coro_derive_padlist (pTHX_ CV *cv)	511	coro_derive_padlist (pTHX_ CV *cv)
414	{	512	{
415	AV *padlist = CvPADLIST (cv);	513	PADLIST *padlist = CvPADLIST (cv);
416	AV *newpadlist, *newpad;	514	PADLIST *newpadlist;
		515	PAD *newpad;
		516	PADOFFSET off = PadlistMAX (padlist) + 1;
417		517
418	newpadlist = newAV ();	518	#if NEWPADAPI
		519
		520	while (!PadlistARRAY (padlist)[off - 1])
		521	--off;
		522
		523	Perl_pad_push (aTHX_ padlist, off);
		524	newpad = PadlistARRAY (padlist)[off];
		525	PadlistARRAY (padlist)[off] = 0;
		526
		527	#else
		528
		529	#if PERL_VERSION_ATLEAST (5,10,0)
		530	Perl_pad_push (aTHX_ padlist, off);
		531	#else
		532	Perl_pad_push (aTHX_ padlist, off, 1);
		533	#endif
		534
		535	newpad = PadlistARRAY (padlist)[off];
		536	PadlistMAX (padlist) = off - 1;
		537
		538	#endif
		539
		540	newPADLIST (newpadlist);
		541	#if !PERL_VERSION_ATLEAST(5,15,3)
		542	/* Padlists are AvREAL as of 5.15.3. See perl bug #98092 and perl commit 7d953ba. */
419	AvREAL_off (newpadlist);	543	AvREAL_off (newpadlist);
420	#if PERL_VERSION_ATLEAST (5,10,0)
421	Perl_pad_push (aTHX_ padlist, AvFILLp (padlist) + 1);
422	#else
423	Perl_pad_push (aTHX_ padlist, AvFILLp (padlist) + 1, 1);
424	#endif	544	#endif
425	newpad = (AV *)AvARRAY (padlist)[AvFILLp (padlist)];
426	--AvFILLp (padlist);
427		545
428	av_store (newpadlist, 0, SvREFCNT_inc_NN (AvARRAY (padlist)[0]));	546	/* Already extended to 2 elements by newPADLIST. */
429	av_store (newpadlist, 1, (SV *)newpad);	547	PadlistMAX (newpadlist) = 1;
		548	PadlistNAMES (newpadlist) = (PADNAMELIST *)SvREFCNT_inc_NN (PadlistNAMES (padlist));
		549	PadlistARRAY (newpadlist)[1] = newpad;
430		550
431	return newpadlist;	551	return newpadlist;
432	}	552	}
433		553
434	static void	554	ecb_inline void
435	free_padlist (pTHX_ AV *padlist)	555	free_padlist (pTHX_ PADLIST *padlist)
436	{	556	{
437	/* may be during global destruction */	557	/* may be during global destruction */
438	if (!IN_DESTRUCT)	558	if (!IN_DESTRUCT)
439	{	559	{
440	I32 i = AvFILLp (padlist);	560	I32 i = PadlistMAX (padlist);
441		561
442	while (i > 0) /* special-case index 0 */	562	while (i > 0) /* special-case index 0 */
443	{	563	{
444	/* we try to be extra-careful here */	564	/* we try to be extra-careful here */
445	AV *av = (AV *)AvARRAY (padlist)[i--];	565	PAD *pad = PadlistARRAY (padlist)[i--];
446	I32 j = AvFILLp (av);	566	I32 j = PadMAX (pad);
447		567
448	while (j >= 0)	568	while (j >= 0)
449	SvREFCNT_dec (AvARRAY (av)[j--]);	569	SvREFCNT_dec (PadARRAY (pad)[j--]);
450		570
451	AvFILLp (av) = -1;	571	PadMAX (pad) = -1;
452	SvREFCNT_dec (av);	572	SvREFCNT_dec (pad);
453	}	573	}
454		574
455	SvREFCNT_dec (AvARRAY (padlist)[0]);	575	SvREFCNT_dec (PadlistNAMES (padlist));
456		576
		577	#if NEWPADAPI
		578	Safefree (PadlistARRAY (padlist));
		579	Safefree (padlist);
		580	#else
457	AvFILLp (padlist) = -1;	581	AvFILLp (padlist) = -1;
		582	AvREAL_off (padlist);
458	SvREFCNT_dec ((SV*)padlist);	583	SvREFCNT_dec ((SV*)padlist);
		584	#endif
459	}	585	}
460	}	586	}
461		587
462	static int	588	static int
463	coro_cv_free (pTHX_ SV *sv, MAGIC *mg)	589	coro_cv_free (pTHX_ SV *sv, MAGIC *mg)
464	{	590	{
465	AV *padlist;	591	PADLIST *padlist;
466	AV *av = (AV *)mg->mg_obj;	592	PADLIST **padlists = (PADLIST **)(mg->mg_ptr + sizeof(size_t));
		593	size_t len = *(size_t *)mg->mg_ptr;
467		594
468	/* casting is fun. */	595	/* perl manages to free our internal AV and _then_ call us */
469	while (&PL_sv_undef != (SV *)(padlist = (AV *)av_pop (av)))	596	if (IN_DESTRUCT)
		597	return 0;
		598
		599	while (len--)
470	free_padlist (aTHX_ padlist);	600	free_padlist (aTHX_ padlists[len]);
471
472	SvREFCNT_dec (av); /* sv_magicext increased the refcount */
473		601
474	return 0;	602	return 0;
475	}	603	}
476		604
477	static MGVTBL coro_cv_vtbl = {	605	static MGVTBL coro_cv_vtbl = {
478	0, 0, 0, 0,	606	0, 0, 0, 0,
479	coro_cv_free	607	coro_cv_free
480	};	608	};
481		609
482	/* the next two functions merely cache the padlists */	610	/* the next two functions merely cache the padlists */
483	static void	611	ecb_inline void
484	get_padlist (pTHX_ CV *cv)	612	get_padlist (pTHX_ CV *cv)
485	{	613	{
486	MAGIC *mg = CORO_MAGIC_cv (cv);	614	MAGIC *mg = CORO_MAGIC_cv (cv);
487	AV *av;	615	size_t *lenp;
488		616
489	if (expect_true (mg && AvFILLp ((av = (AV *)mg->mg_obj)) >= 0))	617	if (ecb_expect_true (mg && *(lenp = (size_t *)mg->mg_ptr)))
490	CvPADLIST (cv) = (AV *)AvARRAY (av)[AvFILLp (av)--];	618	CvPADLIST (cv) = ((PADLIST **)(mg->mg_ptr + sizeof(size_t)))[--*lenp];
491	else	619	else
492	{	620	{
493	#if CORO_PREFER_PERL_FUNCTIONS	621	#if CORO_PREFER_PERL_FUNCTIONS
494	/* this is probably cleaner? but also slower! */	622	/* this is probably cleaner? but also slower! */
495	/* in practise, it seems to be less stable */	623	/* in practise, it seems to be less stable */
…		…
501	CvPADLIST (cv) = coro_derive_padlist (aTHX_ cv);	629	CvPADLIST (cv) = coro_derive_padlist (aTHX_ cv);
502	#endif	630	#endif
503	}	631	}
504	}	632	}
505		633
506	static void	634	ecb_inline void
507	put_padlist (pTHX_ CV *cv)	635	put_padlist (pTHX_ CV *cv)
508	{	636	{
509	MAGIC *mg = CORO_MAGIC_cv (cv);	637	MAGIC *mg = CORO_MAGIC_cv (cv);
510	AV *av;
511		638
512	if (expect_false (!mg))	639	if (ecb_expect_false (!mg))
		640	{
513	mg = sv_magicext ((SV *)cv, (SV *)newAV (), CORO_MAGIC_type_cv, &coro_cv_vtbl, 0, 0);	641	mg = sv_magicext ((SV *)cv, 0, CORO_MAGIC_type_cv, &coro_cv_vtbl, 0, 0);
		642	Newz (0, mg->mg_ptr ,sizeof (size_t) + sizeof (PADLIST *), char);
		643	mg->mg_len = 1; /* so mg_free frees mg_ptr */
		644	}
		645	else
		646	Renew (mg->mg_ptr,
		647	sizeof(size_t) + (*(size_t *)mg->mg_ptr + 1) * sizeof(PADLIST *),
		648	char);
514		649
515	av = (AV *)mg->mg_obj;	650	((PADLIST **)(mg->mg_ptr + sizeof (size_t))) [(*(size_t *)mg->mg_ptr)++] = CvPADLIST (cv);
516
517	if (expect_false (AvFILLp (av) >= AvMAX (av)))
518	av_extend (av, AvFILLp (av) + 1);
519
520	AvARRAY (av)[++AvFILLp (av)] = (SV *)CvPADLIST (cv);
521	}	651	}
522		652
523	/** load & save, init *******************************************************/	653	/** load & save, init *******************************************************/
		654
		655	ecb_inline void
		656	swap_sv (SV *a, SV *b)
		657	{
		658	const U32 keep = SVs_PADSTALE | SVs_PADTMP | SVs_PADMY; /* keep these flags */
		659	SV tmp;
		660
		661	/* swap sv_any */
		662	SvANY (&tmp) = SvANY (a); SvANY (a) = SvANY (b); SvANY (b) = SvANY (&tmp);
		663
		664	/* swap sv_flags */
		665	SvFLAGS (&tmp) = SvFLAGS (a);
		666	SvFLAGS (a) = (SvFLAGS (a) & keep) | (SvFLAGS (b ) & ~keep);
		667	SvFLAGS (b) = (SvFLAGS (b) & keep) | (SvFLAGS (&tmp) & ~keep);
		668
		669	#if PERL_VERSION_ATLEAST (5,10,0)
		670	/* perl 5.10 and later complicates this _quite_ a bit, but it also
		671	* is much faster, so no quarrels here. alternatively, we could
		672	* sv_upgrade to avoid this.
		673	*/
		674	{
		675	/* swap sv_u */
		676	tmp.sv_u = a->sv_u; a->sv_u = b->sv_u; b->sv_u = tmp.sv_u;
		677
		678	/* if SvANY points to the head, we need to adjust the pointers,
		679	* as the pointer for a still points to b, and maybe vice versa.
		680	*/
		681	#define svany_in_head(type) \
		682	(((1 << SVt_NULL) | (1 << SVt_BIND) | (1 << SVt_IV) | (1 << SVt_RV)) & (1 << (type)))
		683
		684	if (svany_in_head (SvTYPE (a)))
		685	SvANY (a) = (void *)((PTRV)SvANY (a) - (PTRV)b + (PTRV)a);
		686
		687	if (svany_in_head (SvTYPE (b)))
		688	SvANY (b) = (void *)((PTRV)SvANY (b) - (PTRV)a + (PTRV)b);
		689	}
		690	#endif
		691	}
		692
		693	/* swap sv heads, at least logically */
		694	static void
		695	swap_svs (pTHX_ Coro__State c)
		696	{
		697	int i;
		698
		699	for (i = 0; i <= AvFILLp (c->swap_sv); i += 2)
		700	swap_sv (AvARRAY (c->swap_sv)[i], AvARRAY (c->swap_sv)[i + 1]);
		701	}
		702
		703	#define SWAP_SVS(coro) \
		704	if (ecb_expect_false ((coro)->swap_sv)) \
		705	swap_svs (aTHX_ (coro))
		706
		707	static void
		708	on_enterleave_call (pTHX_ SV *cb);
524		709
525	static void	710	static void
526	load_perl (pTHX_ Coro__State c)	711	load_perl (pTHX_ Coro__State c)
527	{	712	{
528	perl_slots *slot = c->slot;	713	perl_slots *slot = c->slot;
529	c->slot = 0;	714	c->slot = 0;
530		715
531	PL_mainstack = c->mainstack;	716	PL_mainstack = c->mainstack;
532		717
533	GvSV (PL_defgv) = slot->defsv;	718	#if CORO_JIT
534	GvAV (PL_defgv) = slot->defav;	719	load_perl_slots (slot);
535	GvSV (PL_errgv) = slot->errsv;	720	#else
536	GvSV (irsgv) = slot->irsgv;
537	GvHV (PL_hintgv) = slot->hinthv;
538
539	#define VAR(name,type) PL_ ## name = slot->name;	721	#define VARx(name,expr,type) expr = slot->name;
540	# include "state.h"	722	#include "state.h"
541	#undef VAR	723	#endif
542		724
543	{	725	{
544	dSP;	726	dSP;
545		727
546	CV *cv;	728	CV *cv;
547		729
548	/* now do the ugly restore mess */	730	/* now do the ugly restore mess */
549	while (expect_true (cv = (CV *)POPs))	731	while (ecb_expect_true (cv = (CV *)POPs))
550	{	732	{
551	put_padlist (aTHX_ cv); /* mark this padlist as available */	733	put_padlist (aTHX_ cv); /* mark this padlist as available */
552	CvDEPTH (cv) = PTR2IV (POPs);	734	CvDEPTH (cv) = PTR2IV (POPs);
553	CvPADLIST (cv) = (AV *)POPs;	735	CvPADLIST (cv) = (PADLIST *)POPs;
554	}	736	}
555		737
556	PUTBACK;	738	PUTBACK;
557	}	739	}
558		740
559	slf_frame = c->slf_frame;	741	slf_frame = c->slf_frame;
560	CORO_THROW = c->except;	742	CORO_THROW = c->except;
		743
		744	if (ecb_expect_false (enable_times))
		745	{
		746	if (ecb_expect_false (!times_valid))
		747	coro_times_update ();
		748
		749	coro_times_sub (c);
		750	}
		751
		752	if (ecb_expect_false (c->on_enter))
		753	{
		754	int i;
		755
		756	for (i = 0; i <= AvFILLp (c->on_enter); ++i)
		757	on_enterleave_call (aTHX_ AvARRAY (c->on_enter)[i]);
		758	}
		759
		760	SWAP_SVS (c);
561	}	761	}
562		762
563	static void	763	static void
564	save_perl (pTHX_ Coro__State c)	764	save_perl (pTHX_ Coro__State c)
565	{	765	{
		766	SWAP_SVS (c);
		767
		768	if (ecb_expect_false (c->on_leave))
		769	{
		770	int i;
		771
		772	for (i = AvFILLp (c->on_leave); i >= 0; --i)
		773	on_enterleave_call (aTHX_ AvARRAY (c->on_leave)[i]);
		774	}
		775
		776	times_valid = 0;
		777
		778	if (ecb_expect_false (enable_times))
		779	{
		780	coro_times_update (); times_valid = 1;
		781	coro_times_add (c);
		782	}
		783
566	c->except = CORO_THROW;	784	c->except = CORO_THROW;
567	c->slf_frame = slf_frame;	785	c->slf_frame = slf_frame;
568		786
569	{	787	{
570	dSP;	788	dSP;
…		…
579		797
580	XPUSHs (Nullsv);	798	XPUSHs (Nullsv);
581	/* this loop was inspired by pp_caller */	799	/* this loop was inspired by pp_caller */
582	for (;;)	800	for (;;)
583	{	801	{
584	while (expect_true (cxix >= 0))	802	while (ecb_expect_true (cxix >= 0))
585	{	803	{
586	PERL_CONTEXT *cx = &ccstk[cxix--];	804	PERL_CONTEXT *cx = &ccstk[cxix--];
587		805
588	if (expect_true (CxTYPE (cx) == CXt_SUB || CxTYPE (cx) == CXt_FORMAT))	806	if (ecb_expect_true (CxTYPE (cx) == CXt_SUB) || ecb_expect_false (CxTYPE (cx) == CXt_FORMAT))
589	{	807	{
590	CV *cv = cx->blk_sub.cv;	808	CV *cv = cx->blk_sub.cv;
591		809
592	if (expect_true (CvDEPTH (cv)))	810	if (ecb_expect_true (CvDEPTH (cv)))
593	{	811	{
594	EXTEND (SP, 3);	812	EXTEND (SP, 3);
595	PUSHs ((SV *)CvPADLIST (cv));	813	PUSHs ((SV *)CvPADLIST (cv));
596	PUSHs (INT2PTR (SV *, (IV)CvDEPTH (cv)));	814	PUSHs (INT2PTR (SV *, (IV)CvDEPTH (cv)));
597	PUSHs ((SV *)cv);	815	PUSHs ((SV *)cv);
…		…
600	get_padlist (aTHX_ cv);	818	get_padlist (aTHX_ cv);
601	}	819	}
602	}	820	}
603	}	821	}
604		822
605	if (expect_true (top_si->si_type == PERLSI_MAIN))	823	if (ecb_expect_true (top_si->si_type == PERLSI_MAIN))
606	break;	824	break;
607		825
608	top_si = top_si->si_prev;	826	top_si = top_si->si_prev;
609	ccstk = top_si->si_cxstack;	827	ccstk = top_si->si_cxstack;
610	cxix = top_si->si_cxix;	828	cxix = top_si->si_cxix;
…		…
612		830
613	PUTBACK;	831	PUTBACK;
614	}	832	}
615		833
616	/* allocate some space on the context stack for our purposes */	834	/* allocate some space on the context stack for our purposes */
617	/* we manually unroll here, as usually 2 slots is enough */	835	if (ecb_expect_false (cxstack_ix + (int)SLOT_COUNT >= cxstack_max))
618	if (SLOT_COUNT >= 1) CXINC;
619	if (SLOT_COUNT >= 2) CXINC;
620	if (SLOT_COUNT >= 3) CXINC;
621	{	836	{
622	int i;	837	unsigned int i;
		838
623	for (i = 3; i < SLOT_COUNT; ++i)	839	for (i = 0; i < SLOT_COUNT; ++i)
624	CXINC;	840	CXINC;
625	}	841
626	cxstack_ix -= SLOT_COUNT; /* undo allocation */	842	cxstack_ix -= SLOT_COUNT; /* undo allocation */
		843	}
627		844
628	c->mainstack = PL_mainstack;	845	c->mainstack = PL_mainstack;
629		846
630	{	847	{
631	perl_slots *slot = c->slot = (perl_slots *)(cxstack + cxstack_ix + 1);	848	perl_slots *slot = c->slot = (perl_slots *)(cxstack + cxstack_ix + 1);
632		849
633	slot->defav = GvAV (PL_defgv);	850	#if CORO_JIT
634	slot->defsv = DEFSV;	851	save_perl_slots (slot);
635	slot->errsv = ERRSV;	852	#else
636	slot->irsgv = GvSV (irsgv);
637	slot->hinthv = GvHV (PL_hintgv);
638
639	#define VAR(name,type) slot->name = PL_ ## name;	853	#define VARx(name,expr,type) slot->name = expr;
640	# include "state.h"	854	#include "state.h"
641	#undef VAR	855	#endif
642	}	856	}
643	}	857	}
644		858
645	/*	859	/*
646	* allocate various perl stacks. This is almost an exact copy	860	* allocate various perl stacks. This is almost an exact copy
…		…
652	# define coro_init_stacks(thx) init_stacks ()	866	# define coro_init_stacks(thx) init_stacks ()
653	#else	867	#else
654	static void	868	static void
655	coro_init_stacks (pTHX)	869	coro_init_stacks (pTHX)
656	{	870	{
657	PL_curstackinfo = new_stackinfo(32, 8);	871	PL_curstackinfo = new_stackinfo(32, 4 + SLOT_COUNT); /* 3 is minimum due to perl rounding down in scope.c:GROW() */
658	PL_curstackinfo->si_type = PERLSI_MAIN;	872	PL_curstackinfo->si_type = PERLSI_MAIN;
659	PL_curstack = PL_curstackinfo->si_stack;	873	PL_curstack = PL_curstackinfo->si_stack;
660	PL_mainstack = PL_curstack; /* remember in case we switch stacks */	874	PL_mainstack = PL_curstack; /* remember in case we switch stacks */
661		875
662	PL_stack_base = AvARRAY(PL_curstack);	876	PL_stack_base = AvARRAY(PL_curstack);
…		…
677	#endif	891	#endif
678		892
679	New(54,PL_scopestack,8,I32);	893	New(54,PL_scopestack,8,I32);
680	PL_scopestack_ix = 0;	894	PL_scopestack_ix = 0;
681	PL_scopestack_max = 8;	895	PL_scopestack_max = 8;
		896	#if HAS_SCOPESTACK_NAME
		897	New(54,PL_scopestack_name,8,const char*);
		898	#endif
682		899
683	New(54,PL_savestack,24,ANY);	900	New(54,PL_savestack,24,ANY);
684	PL_savestack_ix = 0;	901	PL_savestack_ix = 0;
685	PL_savestack_max = 24;	902	PL_savestack_max = 24;
686		903
…		…
714	}	931	}
715		932
716	Safefree (PL_tmps_stack);	933	Safefree (PL_tmps_stack);
717	Safefree (PL_markstack);	934	Safefree (PL_markstack);
718	Safefree (PL_scopestack);	935	Safefree (PL_scopestack);
		936	#if HAS_SCOPESTACK_NAME
		937	Safefree (PL_scopestack_name);
		938	#endif
719	Safefree (PL_savestack);	939	Safefree (PL_savestack);
720	#if !PERL_VERSION_ATLEAST (5,10,0)	940	#if !PERL_VERSION_ATLEAST (5,10,0)
721	Safefree (PL_retstack);	941	Safefree (PL_retstack);
722	#endif	942	#endif
723	}	943	}
…		…
769	#endif	989	#endif
770		990
771	/*	991	/*
772	* This overrides the default magic get method of %SIG elements.	992	* This overrides the default magic get method of %SIG elements.
773	* The original one doesn't provide for reading back of PL_diehook/PL_warnhook	993	* The original one doesn't provide for reading back of PL_diehook/PL_warnhook
774	* and instead of tryign to save and restore the hash elements, we just provide	994	* and instead of trying to save and restore the hash elements (extremely slow),
775	* readback here.	995	* we just provide our own readback here.
776	* We only do this when the hook is != 0, as they are often set to 0 temporarily,
777	* not expecting this to actually change the hook. This is a potential problem
778	* when a schedule happens then, but we ignore this.
779	*/	996	*/
780	static int	997	static int ecb_cold
781	coro_sigelem_get (pTHX_ SV *sv, MAGIC *mg)	998	coro_sigelem_get (pTHX_ SV *sv, MAGIC *mg)
782	{	999	{
783	const char *s = MgPV_nolen_const (mg);	1000	const char *s = MgPV_nolen_const (mg);
784		1001
785	if (*s == '_')	1002	if (*s == '_')
786	{	1003	{
787	SV **svp = 0;	1004	SV **svp = 0;
788		1005
789	if (strEQ (s, "__DIE__" )) svp = &PL_diehook;	1006	if (strEQ (s, "__DIE__" )) svp = &PL_diehook;
790	if (strEQ (s, "__WARN__")) svp = &PL_warnhook;	1007	if (strEQ (s, "__WARN__")) svp = &PL_warnhook;
791		1008
792	if (svp)	1009	if (svp)
793	{	1010	{
794	sv_setsv (sv, *svp ? *svp : &PL_sv_undef);	1011	SV *ssv;
		1012
		1013	if (!*svp)
		1014	ssv = &PL_sv_undef;
		1015	else if (SvTYPE (*svp) == SVt_PVCV) /* perlio directly stores a CV in warnhook. ugh. */
		1016	ssv = sv_2mortal (newRV_inc (*svp));
		1017	else
		1018	ssv = *svp;
		1019
		1020	sv_setsv (sv, ssv);
795	return 0;	1021	return 0;
796	}	1022	}
797	}	1023	}
798		1024
799	return orig_sigelem_get ? orig_sigelem_get (aTHX_ sv, mg) : 0;	1025	return orig_sigelem_get ? orig_sigelem_get (aTHX_ sv, mg) : 0;
800	}	1026	}
801		1027
802	static int	1028	static int ecb_cold
803	coro_sigelem_clr (pTHX_ SV *sv, MAGIC *mg)	1029	coro_sigelem_clr (pTHX_ SV *sv, MAGIC *mg)
804	{	1030	{
805	const char *s = MgPV_nolen_const (mg);	1031	const char *s = MgPV_nolen_const (mg);
806		1032
807	if (*s == '_')	1033	if (*s == '_')
…		…
821	}	1047	}
822		1048
823	return orig_sigelem_clr ? orig_sigelem_clr (aTHX_ sv, mg) : 0;	1049	return orig_sigelem_clr ? orig_sigelem_clr (aTHX_ sv, mg) : 0;
824	}	1050	}
825		1051
826	static int	1052	static int ecb_cold
827	coro_sigelem_set (pTHX_ SV *sv, MAGIC *mg)	1053	coro_sigelem_set (pTHX_ SV *sv, MAGIC *mg)
828	{	1054	{
829	const char *s = MgPV_nolen_const (mg);	1055	const char *s = MgPV_nolen_const (mg);
830		1056
831	if (*s == '_')	1057	if (*s == '_')
…		…
836	if (strEQ (s, "__WARN__")) svp = &PL_warnhook;	1062	if (strEQ (s, "__WARN__")) svp = &PL_warnhook;
837		1063
838	if (svp)	1064	if (svp)
839	{	1065	{
840	SV *old = *svp;	1066	SV *old = *svp;
841	*svp = newSVsv (sv);	1067	*svp = SvOK (sv) ? newSVsv (sv) : 0;
842	SvREFCNT_dec (old);	1068	SvREFCNT_dec (old);
843	return 0;	1069	return 0;
844	}	1070	}
845	}	1071	}
846		1072
…		…
864	slf_check_repeat (pTHX_ struct CoroSLF *frame)	1090	slf_check_repeat (pTHX_ struct CoroSLF *frame)
865	{	1091	{
866	return 1;	1092	return 1;
867	}	1093	}
868		1094
869	static UNOP coro_setup_op;	1095	static UNOP init_perl_op;
870		1096
871	static void NOINLINE /* noinline to keep it out of the transfer fast path */	1097	ecb_noinline static void /* noinline to keep it out of the transfer fast path */
872	coro_setup (pTHX_ struct coro *coro)	1098	init_perl (pTHX_ struct coro *coro)
873	{	1099	{
874	/*	1100	/*
875	* emulate part of the perl startup here.	1101	* emulate part of the perl startup here.
876	*/	1102	*/
877	coro_init_stacks (aTHX);	1103	coro_init_stacks (aTHX);
…		…
884	PL_comppad_name_fill = 0;	1110	PL_comppad_name_fill = 0;
885	PL_comppad_name_floor = 0;	1111	PL_comppad_name_floor = 0;
886	PL_curpm = 0;	1112	PL_curpm = 0;
887	PL_curpad = 0;	1113	PL_curpad = 0;
888	PL_localizing = 0;	1114	PL_localizing = 0;
889	PL_dirty = 0;
890	PL_restartop = 0;	1115	PL_restartop = 0;
891	#if PERL_VERSION_ATLEAST (5,10,0)	1116	#if PERL_VERSION_ATLEAST (5,10,0)
892	PL_parser = 0;	1117	PL_parser = 0;
893	#endif	1118	#endif
894	PL_hints = 0;	1119	PL_hints = 0;
895		1120
896	/* recreate the die/warn hooks */	1121	/* recreate the die/warn hooks */
897	PL_diehook = 0; SvSetMagicSV (*hv_fetch (hv_sig, "__DIE__" , sizeof ("__DIE__" ) - 1, 1), rv_diehook );	1122	PL_diehook = SvREFCNT_inc (rv_diehook);
898	PL_warnhook = 0; SvSetMagicSV (*hv_fetch (hv_sig, "__WARN__", sizeof ("__WARN__") - 1, 1), rv_warnhook);	1123	PL_warnhook = SvREFCNT_inc (rv_warnhook);
899		1124
900	GvSV (PL_defgv) = newSV (0);	1125	GvSV (PL_defgv) = newSV (0);
901	GvAV (PL_defgv) = coro->args; coro->args = 0;	1126	GvAV (PL_defgv) = coro->args; coro->args = 0;
902	GvSV (PL_errgv) = newSV (0);	1127	GvSV (PL_errgv) = newSV (0);
903	GvSV (irsgv) = newSVpvn ("\n", 1); sv_magic (GvSV (irsgv), (SV *)irsgv, PERL_MAGIC_sv, "/", 0);	1128	GvSV (irsgv) = newSVpvn ("\n", 1); sv_magic (GvSV (irsgv), (SV *)irsgv, PERL_MAGIC_sv, "/", 0);
904	GvHV (PL_hintgv) = 0;	1129	GvHV (PL_hintgv) = 0;
…		…
924	/* this newly created coroutine might be run on an existing cctx which most	1149	/* this newly created coroutine might be run on an existing cctx which most
925	* likely was suspended in pp_slf, so we have to emulate entering pp_slf here.	1150	* likely was suspended in pp_slf, so we have to emulate entering pp_slf here.
926	*/	1151	*/
927	slf_frame.prepare = prepare_nop; /* provide a nop function for an eventual pp_slf */	1152	slf_frame.prepare = prepare_nop; /* provide a nop function for an eventual pp_slf */
928	slf_frame.check = slf_check_nop; /* signal pp_slf to not repeat */	1153	slf_frame.check = slf_check_nop; /* signal pp_slf to not repeat */
		1154	slf_frame.destroy = 0;
929		1155
930	/* and we have to provide the pp_slf op in any case, so pp_slf can skip it */	1156	/* and we have to provide the pp_slf op in any case, so pp_slf can skip it */
931	coro_setup_op.op_next = PL_op;	1157	init_perl_op.op_next = PL_op;
932	coro_setup_op.op_type = OP_ENTERSUB;	1158	init_perl_op.op_type = OP_ENTERSUB;
933	coro_setup_op.op_ppaddr = pp_slf;	1159	init_perl_op.op_ppaddr = pp_slf;
934	/* no flags etc. required, as an init function won't be called */	1160	/* no flags etc. required, as an init function won't be called */
935		1161
936	PL_op = (OP *)&coro_setup_op;	1162	PL_op = (OP *)&init_perl_op;
937		1163
938	/* copy throw, in case it was set before coro_setup */	1164	/* copy throw, in case it was set before init_perl */
939	CORO_THROW = coro->except;	1165	CORO_THROW = coro->except;
940	}
941		1166
		1167	SWAP_SVS (coro);
		1168
		1169	if (ecb_expect_false (enable_times))
		1170	{
		1171	coro_times_update ();
		1172	coro_times_sub (coro);
		1173	}
		1174	}
		1175
942	static void	1176	static void
943	coro_destruct (pTHX_ struct coro *coro)	1177	coro_unwind_stacks (pTHX)
944	{	1178	{
945	if (!IN_DESTRUCT)	1179	if (!IN_DESTRUCT)
946	{	1180	{
947	/* restore all saved variables and stuff */	1181	/* restore all saved variables and stuff */
948	LEAVE_SCOPE (0);	1182	LEAVE_SCOPE (0);
…		…
956	POPSTACK_TO (PL_mainstack);	1190	POPSTACK_TO (PL_mainstack);
957		1191
958	/* unwind main stack */	1192	/* unwind main stack */
959	dounwind (-1);	1193	dounwind (-1);
960	}	1194	}
		1195	}
961		1196
962	SvREFCNT_dec (GvSV (PL_defgv));	1197	static void
963	SvREFCNT_dec (GvAV (PL_defgv));	1198	destroy_perl (pTHX_ struct coro *coro)
964	SvREFCNT_dec (GvSV (PL_errgv));	1199	{
965	SvREFCNT_dec (PL_defoutgv);	1200	SV *svf [9];
966	SvREFCNT_dec (PL_rs);
967	SvREFCNT_dec (GvSV (irsgv));
968	SvREFCNT_dec (GvHV (PL_hintgv));
969		1201
970	SvREFCNT_dec (PL_diehook);
971	SvREFCNT_dec (PL_warnhook);
972		1202	{
		1203	SV *old_current = SvRV (coro_current);
		1204	struct coro *current = SvSTATE (old_current);
		1205
		1206	assert (("FATAL: tried to destroy currently running coroutine", coro->mainstack != PL_mainstack));
		1207
		1208	save_perl (aTHX_ current);
		1209
		1210	/* this will cause transfer_check to croak on block*/
		1211	SvRV_set (coro_current, (SV *)coro->hv);
		1212
		1213	load_perl (aTHX_ coro);
		1214
		1215	coro_unwind_stacks (aTHX);
		1216
		1217	/* restore swapped sv's */
		1218	SWAP_SVS (coro);
		1219
		1220	coro_destruct_stacks (aTHX);
		1221
		1222	/* now save some sv's to be free'd later */
		1223	svf [0] = GvSV (PL_defgv);
		1224	svf [1] = (SV *)GvAV (PL_defgv);
		1225	svf [2] = GvSV (PL_errgv);
		1226	svf [3] = (SV *)PL_defoutgv;
		1227	svf [4] = PL_rs;
		1228	svf [5] = GvSV (irsgv);
		1229	svf [6] = (SV *)GvHV (PL_hintgv);
		1230	svf [7] = PL_diehook;
		1231	svf [8] = PL_warnhook;
		1232	assert (9 == sizeof (svf) / sizeof (*svf));
		1233
		1234	SvRV_set (coro_current, old_current);
		1235
		1236	load_perl (aTHX_ current);
		1237	}
		1238
		1239	{
		1240	unsigned int i;
		1241
		1242	for (i = 0; i < sizeof (svf) / sizeof (*svf); ++i)
		1243	SvREFCNT_dec (svf [i]);
		1244
973	SvREFCNT_dec (coro->saved_deffh);	1245	SvREFCNT_dec (coro->saved_deffh);
974	SvREFCNT_dec (coro->rouse_cb);	1246	SvREFCNT_dec (coro->rouse_cb);
975	SvREFCNT_dec (coro->invoke_cb);	1247	SvREFCNT_dec (coro->invoke_cb);
976	SvREFCNT_dec (coro->invoke_av);	1248	SvREFCNT_dec (coro->invoke_av);
977		1249	}
978	coro_destruct_stacks (aTHX);
979	}	1250	}
980		1251
981	INLINE void	1252	ecb_inline void
982	free_coro_mortal (pTHX)	1253	free_coro_mortal (pTHX)
983	{	1254	{
984	if (expect_true (coro_mortal))	1255	if (ecb_expect_true (coro_mortal))
985	{	1256	{
986	SvREFCNT_dec (coro_mortal);	1257	SvREFCNT_dec ((SV *)coro_mortal);
987	coro_mortal = 0;	1258	coro_mortal = 0;
988	}	1259	}
989	}	1260	}
990		1261
991	static int	1262	static int
…		…
1124		1395
1125	return frame->check (aTHX_ frame); /* execute the restored frame - there must be one */	1396	return frame->check (aTHX_ frame); /* execute the restored frame - there must be one */
1126	}	1397	}
1127		1398
1128	/* initialises PL_top_env and injects a pseudo-slf-call to set the stacklevel */	1399	/* initialises PL_top_env and injects a pseudo-slf-call to set the stacklevel */
1129	static void NOINLINE	1400	static void ecb_noinline
1130	cctx_prepare (pTHX)	1401	cctx_prepare (pTHX)
1131	{	1402	{
1132	PL_top_env = &PL_start_env;	1403	PL_top_env = &PL_start_env;
1133		1404
1134	if (cctx_current->flags & CC_TRACE)	1405	if (cctx_current->flags & CC_TRACE)
…		…
1145	slf_frame.prepare = slf_prepare_set_stacklevel;	1416	slf_frame.prepare = slf_prepare_set_stacklevel;
1146	slf_frame.check = slf_check_set_stacklevel;	1417	slf_frame.check = slf_check_set_stacklevel;
1147	}	1418	}
1148		1419
1149	/* the tail of transfer: execute stuff we can only do after a transfer */	1420	/* the tail of transfer: execute stuff we can only do after a transfer */
1150	INLINE void	1421	ecb_inline void
1151	transfer_tail (pTHX)	1422	transfer_tail (pTHX)
1152	{	1423	{
1153	free_coro_mortal (aTHX);	1424	free_coro_mortal (aTHX);
		1425	}
		1426
		1427	/* try to exit the same way perl's main function would do */
		1428	/* we do not bother resetting the environment or other things *7
		1429	/* that are not, uhm, essential */
		1430	/* this obviously also doesn't work when perl is embedded */
		1431	static void ecb_noinline ecb_cold
		1432	perlish_exit (pTHX)
		1433	{
		1434	int exitstatus = perl_destruct (PL_curinterp);
		1435	perl_free (PL_curinterp);
		1436	exit (exitstatus);
1154	}	1437	}
1155		1438
1156	/*	1439	/*
1157	* this is a _very_ stripped down perl interpreter ;)	1440	* this is a _very_ stripped down perl interpreter ;)
1158	*/	1441	*/
…		…
1180	/* somebody or something will hit me for both perl_run and PL_restartop */	1463	/* somebody or something will hit me for both perl_run and PL_restartop */
1181	PL_restartop = PL_op;	1464	PL_restartop = PL_op;
1182	perl_run (PL_curinterp);	1465	perl_run (PL_curinterp);
1183	/*	1466	/*
1184	* Unfortunately, there is no way to get at the return values of the	1467	* Unfortunately, there is no way to get at the return values of the
1185	* coro body here, as perl_run destroys these	1468	* coro body here, as perl_run destroys these. Likewise, we cannot catch
		1469	* runtime errors here, as this is just a random interpreter, not a thread.
1186	*/	1470	*/
1187		1471
1188	/*	1472	/*
1189	* If perl-run returns we assume exit() was being called or the coro	1473	* If perl-run returns we assume exit() was being called or the coro
1190	* fell off the end, which seems to be the only valid (non-bug)	1474	* fell off the end, which seems to be the only valid (non-bug)
1191	* reason for perl_run to return. We try to exit by jumping to the	1475	* reason for perl_run to return. We try to mimic whatever perl is normally
1192	* bootstrap-time "top" top_env, as we cannot restore the "main"	1476	* doing in that case. YMMV.
1193	* coroutine as Coro has no such concept.
1194	* This actually isn't valid with the pthread backend, but OSes requiring
1195	* that backend are too broken to do it in a standards-compliant way.
1196	*/	1477	*/
1197	PL_top_env = main_top_env;	1478	perlish_exit (aTHX);
1198	JMPENV_JUMP (2); /* I do not feel well about the hardcoded 2 at all */
1199	}	1479	}
1200	}	1480	}
1201		1481
1202	static coro_cctx *	1482	static coro_cctx *
1203	cctx_new ()	1483	cctx_new (void)
1204	{	1484	{
1205	coro_cctx *cctx;	1485	coro_cctx *cctx;
1206		1486
1207	++cctx_count;	1487	++cctx_count;
1208	New (0, cctx, 1, coro_cctx);	1488	New (0, cctx, 1, coro_cctx);
…		…
1214	return cctx;	1494	return cctx;
1215	}	1495	}
1216		1496
1217	/* create a new cctx only suitable as source */	1497	/* create a new cctx only suitable as source */
1218	static coro_cctx *	1498	static coro_cctx *
1219	cctx_new_empty ()	1499	cctx_new_empty (void)
1220	{	1500	{
1221	coro_cctx *cctx = cctx_new ();	1501	coro_cctx *cctx = cctx_new ();
1222		1502
1223	cctx->sptr = 0;	1503	cctx->stack.sptr = 0;
1224	coro_create (&cctx->cctx, 0, 0, 0, 0);	1504	coro_create (&cctx->cctx, 0, 0, 0, 0);
1225		1505
1226	return cctx;	1506	return cctx;
1227	}	1507	}
1228		1508
1229	/* create a new cctx suitable as destination/running a perl interpreter */	1509	/* create a new cctx suitable as destination/running a perl interpreter */
1230	static coro_cctx *	1510	static coro_cctx *
1231	cctx_new_run ()	1511	cctx_new_run (void)
1232	{	1512	{
1233	coro_cctx *cctx = cctx_new ();	1513	coro_cctx *cctx = cctx_new ();
1234	void *stack_start;
1235	size_t stack_size;
1236		1514
1237	#if HAVE_MMAP	1515	if (!coro_stack_alloc (&cctx->stack, cctx_stacksize))
1238	cctx->ssize = ((cctx_stacksize * sizeof (long) + PAGESIZE - 1) / PAGESIZE + CORO_STACKGUARD) * PAGESIZE;
1239	/* mmap supposedly does allocate-on-write for us */
1240	cctx->sptr = mmap (0, cctx->ssize, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_PRIVATE|MAP_ANONYMOUS, 0, 0);
1241
1242	if (cctx->sptr != (void *)-1)
1243	{
1244	#if CORO_STACKGUARD
1245	mprotect (cctx->sptr, CORO_STACKGUARD * PAGESIZE, PROT_NONE);
1246	#endif
1247	stack_start = (char *)cctx->sptr + CORO_STACKGUARD * PAGESIZE;
1248	stack_size = cctx->ssize - CORO_STACKGUARD * PAGESIZE;
1249	cctx->flags |= CC_MAPPED;
1250	}	1516	{
1251	else
1252	#endif
1253	{
1254	cctx->ssize = cctx_stacksize * (long)sizeof (long);
1255	New (0, cctx->sptr, cctx_stacksize, long);
1256
1257	if (!cctx->sptr)
1258	{
1259	perror ("FATAL: unable to allocate stack for coroutine, exiting.");	1517	perror ("FATAL: unable to allocate stack for coroutine, exiting.");
1260	_exit (EXIT_FAILURE);	1518	_exit (EXIT_FAILURE);
1261	}
1262
1263	stack_start = cctx->sptr;
1264	stack_size = cctx->ssize;
1265	}	1519	}
1266		1520
1267	#if CORO_USE_VALGRIND
1268	cctx->valgrind_id = VALGRIND_STACK_REGISTER ((char *)stack_start, (char *)stack_start + stack_size);
1269	#endif
1270
1271	coro_create (&cctx->cctx, cctx_run, (void *)cctx, stack_start, stack_size);	1521	coro_create (&cctx->cctx, cctx_run, (void *)cctx, cctx->stack.sptr, cctx->stack.ssze);
1272		1522
1273	return cctx;	1523	return cctx;
1274	}	1524	}
1275		1525
1276	static void	1526	static void
1277	cctx_destroy (coro_cctx *cctx)	1527	cctx_destroy (coro_cctx *cctx)
1278	{	1528	{
1279	if (!cctx)	1529	if (!cctx)
1280	return;	1530	return;
1281		1531
1282	assert (cctx != cctx_current);//D temporary	1532	assert (("FATAL: tried to destroy current cctx", cctx != cctx_current));
1283		1533
1284	--cctx_count;	1534	--cctx_count;
1285	coro_destroy (&cctx->cctx);	1535	coro_destroy (&cctx->cctx);
1286		1536
1287	/* coro_transfer creates new, empty cctx's */	1537	coro_stack_free (&cctx->stack);
1288	if (cctx->sptr)
1289	{
1290	#if CORO_USE_VALGRIND
1291	VALGRIND_STACK_DEREGISTER (cctx->valgrind_id);
1292	#endif
1293
1294	#if HAVE_MMAP
1295	if (cctx->flags & CC_MAPPED)
1296	munmap (cctx->sptr, cctx->ssize);
1297	else
1298	#endif
1299	Safefree (cctx->sptr);
1300	}
1301		1538
1302	Safefree (cctx);	1539	Safefree (cctx);
1303	}	1540	}
1304		1541
1305	/* wether this cctx should be destructed */	1542	/* wether this cctx should be destructed */
1306	#define CCTX_EXPIRED(cctx) ((cctx)->gen != cctx_gen || ((cctx)->flags & CC_NOREUSE))	1543	#define CCTX_EXPIRED(cctx) ((cctx)->gen != cctx_gen || ((cctx)->flags & CC_NOREUSE))
1307		1544
1308	static coro_cctx *	1545	static coro_cctx *
1309	cctx_get (pTHX)	1546	cctx_get (pTHX)
1310	{	1547	{
1311	while (expect_true (cctx_first))	1548	while (ecb_expect_true (cctx_first))
1312	{	1549	{
1313	coro_cctx *cctx = cctx_first;	1550	coro_cctx *cctx = cctx_first;
1314	cctx_first = cctx->next;	1551	cctx_first = cctx->next;
1315	--cctx_idle;	1552	--cctx_idle;
1316		1553
1317	if (expect_true (!CCTX_EXPIRED (cctx)))	1554	if (ecb_expect_true (!CCTX_EXPIRED (cctx)))
1318	return cctx;	1555	return cctx;
1319		1556
1320	cctx_destroy (cctx);	1557	cctx_destroy (cctx);
1321	}	1558	}
1322		1559
…		…
1324	}	1561	}
1325		1562
1326	static void	1563	static void
1327	cctx_put (coro_cctx *cctx)	1564	cctx_put (coro_cctx *cctx)
1328	{	1565	{
1329	assert (("FATAL: cctx_put called on non-initialised cctx in Coro (please report)", cctx->sptr));	1566	assert (("FATAL: cctx_put called on non-initialised cctx in Coro (please report)", cctx->stack.sptr));
1330		1567
1331	/* free another cctx if overlimit */	1568	/* free another cctx if overlimit */
1332	if (expect_false (cctx_idle >= cctx_max_idle))	1569	if (ecb_expect_false (cctx_idle >= cctx_max_idle))
1333	{	1570	{
1334	coro_cctx *first = cctx_first;	1571	coro_cctx *first = cctx_first;
1335	cctx_first = first->next;	1572	cctx_first = first->next;
1336	--cctx_idle;	1573	--cctx_idle;
1337		1574
…		…
1348	static void	1585	static void
1349	transfer_check (pTHX_ struct coro *prev, struct coro *next)	1586	transfer_check (pTHX_ struct coro *prev, struct coro *next)
1350	{	1587	{
1351	/* TODO: throwing up here is considered harmful */	1588	/* TODO: throwing up here is considered harmful */
1352		1589
1353	if (expect_true (prev != next))	1590	if (ecb_expect_true (prev != next))
1354	{	1591	{
1355	if (expect_false (!(prev->flags & (CF_RUNNING | CF_NEW))))	1592	if (ecb_expect_false (!(prev->flags & (CF_RUNNING | CF_NEW))))
1356	croak ("Coro::State::transfer called with a suspended prev Coro::State, but can only transfer from running or new states,");	1593	croak ("Coro::State::transfer called with a blocked prev Coro::State, but can only transfer from running or new states,");
1357		1594
1358	if (expect_false (next->flags & CF_RUNNING))	1595	if (ecb_expect_false (next->flags & (CF_RUNNING | CF_ZOMBIE | CF_SUSPENDED)))
1359	croak ("Coro::State::transfer called with running next Coro::State, but can only transfer to inactive states,");
1360
1361	if (expect_false (next->flags & CF_DESTROYED))
1362	croak ("Coro::State::transfer called with destroyed next Coro::State, but can only transfer to inactive states,");	1596	croak ("Coro::State::transfer called with running, destroyed or suspended next Coro::State, but can only transfer to inactive states,");
1363		1597
1364	#if !PERL_VERSION_ATLEAST (5,10,0)	1598	#if !PERL_VERSION_ATLEAST (5,10,0)
1365	if (expect_false (PL_lex_state != LEX_NOTPARSING))	1599	if (ecb_expect_false (PL_lex_state != LEX_NOTPARSING))
1366	croak ("Coro::State::transfer called while parsing, but this is not supported in your perl version,");	1600	croak ("Coro::State::transfer called while parsing, but this is not supported in your perl version,");
1367	#endif	1601	#endif
1368	}	1602	}
1369	}	1603	}
1370		1604
1371	/* always use the TRANSFER macro */	1605	/* always use the TRANSFER macro */
1372	static void NOINLINE /* noinline so we have a fixed stackframe */	1606	static void ecb_noinline /* noinline so we have a fixed stackframe */
1373	transfer (pTHX_ struct coro *prev, struct coro *next, int force_cctx)	1607	transfer (pTHX_ struct coro *prev, struct coro *next, int force_cctx)
1374	{	1608	{
1375	dSTACKLEVEL;	1609	dSTACKLEVEL;
1376		1610
1377	/* sometimes transfer is only called to set idle_sp */	1611	/* sometimes transfer is only called to set idle_sp */
1378	if (expect_false (!prev))	1612	if (ecb_expect_false (!prev))
1379	{	1613	{
1380	cctx_current->idle_sp = STACKLEVEL;	1614	cctx_current->idle_sp = STACKLEVEL;
1381	assert (cctx_current->idle_te = PL_top_env); /* just for the side-effect when asserts are enabled */	1615	assert (cctx_current->idle_te = PL_top_env); /* just for the side-effect when asserts are enabled */
1382	}	1616	}
1383	else if (expect_true (prev != next))	1617	else if (ecb_expect_true (prev != next))
1384	{	1618	{
1385	coro_cctx *cctx_prev;	1619	coro_cctx *cctx_prev;
1386		1620
1387	if (expect_false (prev->flags & CF_NEW))	1621	if (ecb_expect_false (prev->flags & CF_NEW))
1388	{	1622	{
1389	/* create a new empty/source context */	1623	/* create a new empty/source context */
1390	prev->flags &= ~CF_NEW;	1624	prev->flags &= ~CF_NEW;
1391	prev->flags |= CF_RUNNING;	1625	prev->flags |= CF_RUNNING;
1392	}	1626	}
…		…
1395	next->flags |= CF_RUNNING;	1629	next->flags |= CF_RUNNING;
1396		1630
1397	/* first get rid of the old state */	1631	/* first get rid of the old state */
1398	save_perl (aTHX_ prev);	1632	save_perl (aTHX_ prev);
1399		1633
1400	if (expect_false (next->flags & CF_NEW))	1634	if (ecb_expect_false (next->flags & CF_NEW))
1401	{	1635	{
1402	/* need to start coroutine */	1636	/* need to start coroutine */
1403	next->flags &= ~CF_NEW;	1637	next->flags &= ~CF_NEW;
1404	/* setup coroutine call */	1638	/* setup coroutine call */
1405	coro_setup (aTHX_ next);	1639	init_perl (aTHX_ next);
1406	}	1640	}
1407	else	1641	else
1408	load_perl (aTHX_ next);	1642	load_perl (aTHX_ next);
1409		1643
1410	assert (!prev->cctx);//D temporary
1411
1412	/* possibly untie and reuse the cctx */	1644	/* possibly untie and reuse the cctx */
1413	if (expect_true (	1645	if (ecb_expect_true (
1414	cctx_current->idle_sp == STACKLEVEL	1646	cctx_current->idle_sp == STACKLEVEL
1415	&& !(cctx_current->flags & CC_TRACE)	1647	&& !(cctx_current->flags & CC_TRACE)
1416	&& !force_cctx	1648	&& !force_cctx
1417	))	1649	))
1418	{	1650	{
1419	/* I assume that stacklevel is a stronger indicator than PL_top_env changes */	1651	/* I assume that stacklevel is a stronger indicator than PL_top_env changes */
1420	assert (("FATAL: current top_env must equal previous top_env in Coro (please report)", PL_top_env == cctx_current->idle_te));	1652	assert (("FATAL: current top_env must equal previous top_env in Coro (please report)", PL_top_env == cctx_current->idle_te));
1421		1653
1422	/* if the cctx is about to be destroyed we need to make sure we won't see it in cctx_get. */	1654	/* if the cctx is about to be destroyed we need to make sure we won't see it in cctx_get. */
1423	/* without this the next cctx_get might destroy the running cctx while still in use */	1655	/* without this the next cctx_get might destroy the running cctx while still in use */
1424	if (expect_false (CCTX_EXPIRED (cctx_current)))	1656	if (ecb_expect_false (CCTX_EXPIRED (cctx_current)))
1425	if (expect_true (!next->cctx))	1657	if (ecb_expect_true (!next->cctx))
1426	next->cctx = cctx_get (aTHX);	1658	next->cctx = cctx_get (aTHX);
1427		1659
1428	cctx_put (cctx_current);	1660	cctx_put (cctx_current);
1429	}	1661	}
1430	else	1662	else
1431	prev->cctx = cctx_current;	1663	prev->cctx = cctx_current;
1432		1664
1433	++next->usecount;	1665	++next->usecount;
1434		1666
1435	cctx_prev = cctx_current;	1667	cctx_prev = cctx_current;
1436	cctx_current = expect_false (next->cctx) ? next->cctx : cctx_get (aTHX);	1668	cctx_current = ecb_expect_false (next->cctx) ? next->cctx : cctx_get (aTHX);
1437		1669
1438	next->cctx = 0;	1670	next->cctx = 0;
1439		1671
1440	if (expect_false (cctx_prev != cctx_current))	1672	if (ecb_expect_false (cctx_prev != cctx_current))
1441	{	1673	{
1442	cctx_prev->top_env = PL_top_env;	1674	cctx_prev->top_env = PL_top_env;
1443	PL_top_env = cctx_current->top_env;	1675	PL_top_env = cctx_current->top_env;
1444	coro_transfer (&cctx_prev->cctx, &cctx_current->cctx);	1676	coro_transfer (&cctx_prev->cctx, &cctx_current->cctx);
1445	}	1677	}
…		…
1451	#define TRANSFER(ta, force_cctx) transfer (aTHX_ (ta).prev, (ta).next, (force_cctx))	1683	#define TRANSFER(ta, force_cctx) transfer (aTHX_ (ta).prev, (ta).next, (force_cctx))
1452	#define TRANSFER_CHECK(ta) transfer_check (aTHX_ (ta).prev, (ta).next)	1684	#define TRANSFER_CHECK(ta) transfer_check (aTHX_ (ta).prev, (ta).next)
1453		1685
1454	/** high level stuff ********************************************************/	1686	/** high level stuff ********************************************************/
1455		1687
		1688	/* this function is actually Coro, not Coro::State, but we call it from here */
		1689	/* because it is convenient - but it hasn't been declared yet for that reason */
1456	static int	1690	static void
		1691	coro_call_on_destroy (pTHX_ struct coro *coro);
		1692
		1693	static void
1457	coro_state_destroy (pTHX_ struct coro *coro)	1694	coro_state_destroy (pTHX_ struct coro *coro)
1458	{	1695	{
1459	if (coro->flags & CF_DESTROYED)	1696	if (coro->flags & CF_ZOMBIE)
1460	return 0;	1697	return;
1461		1698
1462	if (coro->on_destroy)
1463	coro->on_destroy (aTHX_ coro);	1699	slf_destroy (aTHX_ coro);
1464		1700
1465	coro->flags |= CF_DESTROYED;	1701	coro->flags |= CF_ZOMBIE;
1466		1702
1467	if (coro->flags & CF_READY)	1703	if (coro->flags & CF_READY)
1468	{	1704	{
1469	/* reduce nready, as destroying a ready coro effectively unreadies it */	1705	/* reduce nready, as destroying a ready coro effectively unreadies it */
1470	/* alternative: look through all ready queues and remove the coro */	1706	/* alternative: look through all ready queues and remove the coro */
1471	--coro_nready;	1707	--coro_nready;
1472	}	1708	}
1473	else	1709	else
1474	coro->flags |= CF_READY; /* make sure it is NOT put into the readyqueue */	1710	coro->flags |= CF_READY; /* make sure it is NOT put into the readyqueue */
1475		1711
1476	if (coro->mainstack && coro->mainstack != main_mainstack)	1712	if (coro->next) coro->next->prev = coro->prev;
1477	{	1713	if (coro->prev) coro->prev->next = coro->next;
1478	struct coro temp;	1714	if (coro == coro_first) coro_first = coro->next;
1479		1715
1480	assert (("FATAL: tried to destroy currently running coroutine (please report)", !(coro->flags & CF_RUNNING)));	1716	if (coro->mainstack
1481		1717	&& coro->mainstack != main_mainstack
1482	save_perl (aTHX_ &temp);	1718	&& coro->slot
		1719	&& !PL_dirty)
1483	load_perl (aTHX_ coro);	1720	destroy_perl (aTHX_ coro);
1484
1485	coro_destruct (aTHX_ coro);
1486
1487	load_perl (aTHX_ &temp);
1488
1489	coro->slot = 0;
1490	}
1491		1721
1492	cctx_destroy (coro->cctx);	1722	cctx_destroy (coro->cctx);
1493	SvREFCNT_dec (coro->startcv);	1723	SvREFCNT_dec (coro->startcv);
1494	SvREFCNT_dec (coro->args);	1724	SvREFCNT_dec (coro->args);
		1725	SvREFCNT_dec (coro->swap_sv);
1495	SvREFCNT_dec (CORO_THROW);	1726	SvREFCNT_dec (CORO_THROW);
1496		1727
1497	if (coro->next) coro->next->prev = coro->prev;	1728	coro_call_on_destroy (aTHX_ coro);
1498	if (coro->prev) coro->prev->next = coro->next;
1499	if (coro == coro_first) coro_first = coro->next;
1500		1729
1501	return 1;	1730	/* more destruction mayhem in coro_state_free */
1502	}	1731	}
1503		1732
1504	static int	1733	static int
1505	coro_state_free (pTHX_ SV *sv, MAGIC *mg)	1734	coro_state_free (pTHX_ SV *sv, MAGIC *mg)
1506	{	1735	{
1507	struct coro *coro = (struct coro *)mg->mg_ptr;	1736	struct coro *coro = (struct coro *)mg->mg_ptr;
1508	mg->mg_ptr = 0;	1737	mg->mg_ptr = 0;
1509		1738
1510	coro->hv = 0;
1511
1512	if (--coro->refcnt < 0)
1513	{
1514	coro_state_destroy (aTHX_ coro);	1739	coro_state_destroy (aTHX_ coro);
		1740	SvREFCNT_dec (coro->on_destroy);
		1741	SvREFCNT_dec (coro->status);
		1742
1515	Safefree (coro);	1743	Safefree (coro);
1516	}
1517		1744
1518	return 0;	1745	return 0;
1519	}	1746	}
1520		1747
1521	static int	1748	static int ecb_cold
1522	coro_state_dup (pTHX_ MAGIC *mg, CLONE_PARAMS *params)	1749	coro_state_dup (pTHX_ MAGIC *mg, CLONE_PARAMS *params)
1523	{	1750	{
1524	struct coro *coro = (struct coro *)mg->mg_ptr;	1751	/* called when perl clones the current process the slow way (windows process emulation) */
1525		1752	/* WE SIMply nuke the pointers in the copy, causing perl to croak */
1526	++coro->refcnt;	1753	mg->mg_ptr = 0;
		1754	mg->mg_virtual = 0;
1527		1755
1528	return 0;	1756	return 0;
1529	}	1757	}
1530		1758
1531	static MGVTBL coro_state_vtbl = {	1759	static MGVTBL coro_state_vtbl = {
…		…
1554		1782
1555	prepare_transfer (aTHX_ &ta, prev_sv, next_sv);	1783	prepare_transfer (aTHX_ &ta, prev_sv, next_sv);
1556	TRANSFER (ta, 1);	1784	TRANSFER (ta, 1);
1557	}	1785	}
1558		1786
1559	/*****************************************************************************/
1560	/* gensub: simple closure generation utility */
1561
1562	#define GENSUB_ARG CvXSUBANY (cv).any_ptr
1563
1564	/* create a closure from XS, returns a code reference */
1565	/* the arg can be accessed via GENSUB_ARG from the callback */
1566	/* the callback must use dXSARGS/XSRETURN */
1567	static SV *
1568	gensub (pTHX_ void (*xsub)(pTHX_ CV *), void *arg)
1569	{
1570	CV *cv = (CV *)newSV (0);
1571
1572	sv_upgrade ((SV *)cv, SVt_PVCV);
1573
1574	CvANON_on (cv);
1575	CvISXSUB_on (cv);
1576	CvXSUB (cv) = xsub;
1577	GENSUB_ARG = arg;
1578
1579	return newRV_noinc ((SV *)cv);
1580	}
1581
1582	/** Coro ********************************************************************/	1787	/** Coro ********************************************************************/
1583		1788
1584	INLINE void	1789	ecb_inline void
1585	coro_enq (pTHX_ struct coro *coro)	1790	coro_enq (pTHX_ struct coro *coro)
1586	{	1791	{
1587	av_push (coro_ready [coro->prio - PRIO_MIN], SvREFCNT_inc_NN (coro->hv));	1792	struct coro **ready = coro_ready [coro->prio - CORO_PRIO_MIN];
1588	}
1589		1793
1590	INLINE SV *	1794	SvREFCNT_inc_NN (coro->hv);
		1795
		1796	coro->next_ready = 0;
		1797	*(ready [0] ? &ready [1]->next_ready : &ready [0]) = coro;
		1798	ready [1] = coro;
		1799	}
		1800
		1801	ecb_inline struct coro *
1591	coro_deq (pTHX)	1802	coro_deq (pTHX)
1592	{	1803	{
1593	int prio;	1804	int prio;
1594		1805
1595	for (prio = PRIO_MAX - PRIO_MIN + 1; --prio >= 0; )	1806	for (prio = CORO_PRIO_MAX - CORO_PRIO_MIN + 1; --prio >= 0; )
1596	if (AvFILLp (coro_ready [prio]) >= 0)	1807	{
1597	return av_shift (coro_ready [prio]);	1808	struct coro **ready = coro_ready [prio];
		1809
		1810	if (ready [0])
		1811	{
		1812	struct coro *coro = ready [0];
		1813	ready [0] = coro->next_ready;
		1814	return coro;
		1815	}
		1816	}
1598		1817
1599	return 0;	1818	return 0;
		1819	}
		1820
		1821	static void
		1822	invoke_sv_ready_hook_helper (void)
		1823	{
		1824	dTHX;
		1825	dSP;
		1826
		1827	ENTER;
		1828	SAVETMPS;
		1829
		1830	PUSHMARK (SP);
		1831	PUTBACK;
		1832	call_sv (coro_readyhook, G_VOID | G_DISCARD);
		1833
		1834	FREETMPS;
		1835	LEAVE;
1600	}	1836	}
1601		1837
1602	static int	1838	static int
1603	api_ready (pTHX_ SV *coro_sv)	1839	api_ready (pTHX_ SV *coro_sv)
1604	{	1840	{
1605	struct coro *coro;
1606	SV *sv_hook;
1607	void (*xs_hook)(void);
1608
1609	coro = SvSTATE (coro_sv);	1841	struct coro *coro = SvSTATE (coro_sv);
1610		1842
1611	if (coro->flags & CF_READY)	1843	if (coro->flags & CF_READY)
1612	return 0;	1844	return 0;
1613		1845
1614	coro->flags |= CF_READY;	1846	coro->flags |= CF_READY;
1615		1847
1616	sv_hook = coro_nready ? 0 : coro_readyhook;
1617	xs_hook = coro_nready ? 0 : coroapi.readyhook;
1618
1619	coro_enq (aTHX_ coro);	1848	coro_enq (aTHX_ coro);
1620	++coro_nready;
1621		1849
1622	if (sv_hook)	1850	if (!coro_nready++)
1623	{	1851	if (coroapi.readyhook)
1624	dSP;	1852	coroapi.readyhook ();
1625
1626	ENTER;
1627	SAVETMPS;
1628
1629	PUSHMARK (SP);
1630	PUTBACK;
1631	call_sv (sv_hook, G_VOID | G_DISCARD);
1632
1633	FREETMPS;
1634	LEAVE;
1635	}
1636
1637	if (xs_hook)
1638	xs_hook ();
1639		1853
1640	return 1;	1854	return 1;
1641	}	1855	}
1642		1856
1643	static int	1857	static int
…		…
1645	{	1859	{
1646	return !!(SvSTATE (coro_sv)->flags & CF_READY);	1860	return !!(SvSTATE (coro_sv)->flags & CF_READY);
1647	}	1861	}
1648		1862
1649	/* expects to own a reference to next->hv */	1863	/* expects to own a reference to next->hv */
1650	INLINE void	1864	ecb_inline void
1651	prepare_schedule_to (pTHX_ struct coro_transfer_args *ta, struct coro *next)	1865	prepare_schedule_to (pTHX_ struct coro_transfer_args *ta, struct coro *next)
1652	{	1866	{
1653	SV *prev_sv = SvRV (coro_current);	1867	SV *prev_sv = SvRV (coro_current);
1654		1868
1655	ta->prev = SvSTATE_hv (prev_sv);	1869	ta->prev = SvSTATE_hv (prev_sv);
…		…
1666	static void	1880	static void
1667	prepare_schedule (pTHX_ struct coro_transfer_args *ta)	1881	prepare_schedule (pTHX_ struct coro_transfer_args *ta)
1668	{	1882	{
1669	for (;;)	1883	for (;;)
1670	{	1884	{
1671	SV *next_sv = coro_deq (aTHX);	1885	struct coro *next = coro_deq (aTHX);
1672		1886
1673	if (expect_true (next_sv))	1887	if (ecb_expect_true (next))
1674	{	1888	{
1675	struct coro *next = SvSTATE_hv (next_sv);
1676
1677	/* cannot transfer to destroyed coros, skip and look for next */	1889	/* cannot transfer to destroyed coros, skip and look for next */
1678	if (expect_false (next->flags & CF_DESTROYED))	1890	if (ecb_expect_false (next->flags & (CF_ZOMBIE | CF_SUSPENDED)))
1679	SvREFCNT_dec (next_sv); /* coro_nready has already been taken care of by destroy */	1891	SvREFCNT_dec (next->hv); /* coro_nready has already been taken care of by destroy */
1680	else	1892	else
1681	{	1893	{
1682	next->flags &= ~CF_READY;	1894	next->flags &= ~CF_READY;
1683	--coro_nready;	1895	--coro_nready;
1684		1896
…		…
1690	{	1902	{
1691	/* nothing to schedule: call the idle handler */	1903	/* nothing to schedule: call the idle handler */
1692	if (SvROK (sv_idle)	1904	if (SvROK (sv_idle)
1693	&& SvOBJECT (SvRV (sv_idle)))	1905	&& SvOBJECT (SvRV (sv_idle)))
1694	{	1906	{
		1907	if (SvRV (sv_idle) == SvRV (coro_current))
		1908	croak ("FATAL: $Coro::IDLE blocked itself - did you try to block inside an event loop callback? Caught");
		1909
1695	++coro_nready; /* hack so that api_ready doesn't invoke ready hook */	1910	++coro_nready; /* hack so that api_ready doesn't invoke ready hook */
1696	api_ready (aTHX_ SvRV (sv_idle));	1911	api_ready (aTHX_ SvRV (sv_idle));
1697	--coro_nready;	1912	--coro_nready;
1698	}	1913	}
1699	else	1914	else
1700	{	1915	{
		1916	/* TODO: deprecated, remove, cannot work reliably *//*D*/
1701	dSP;	1917	dSP;
1702		1918
1703	ENTER;	1919	ENTER;
1704	SAVETMPS;	1920	SAVETMPS;
1705		1921
…		…
1712	}	1928	}
1713	}	1929	}
1714	}	1930	}
1715	}	1931	}
1716		1932
1717	INLINE void	1933	ecb_inline void
1718	prepare_cede (pTHX_ struct coro_transfer_args *ta)	1934	prepare_cede (pTHX_ struct coro_transfer_args *ta)
1719	{	1935	{
1720	api_ready (aTHX_ coro_current);	1936	api_ready (aTHX_ coro_current);
1721	prepare_schedule (aTHX_ ta);	1937	prepare_schedule (aTHX_ ta);
1722	}	1938	}
1723		1939
1724	INLINE void	1940	ecb_inline void
1725	prepare_cede_notself (pTHX_ struct coro_transfer_args *ta)	1941	prepare_cede_notself (pTHX_ struct coro_transfer_args *ta)
1726	{	1942	{
1727	SV *prev = SvRV (coro_current);	1943	SV *prev = SvRV (coro_current);
1728		1944
1729	if (coro_nready)	1945	if (coro_nready)
…		…
1759	{	1975	{
1760	struct coro_transfer_args ta;	1976	struct coro_transfer_args ta;
1761		1977
1762	prepare_cede (aTHX_ &ta);	1978	prepare_cede (aTHX_ &ta);
1763		1979
1764	if (expect_true (ta.prev != ta.next))	1980	if (ecb_expect_true (ta.prev != ta.next))
1765	{	1981	{
1766	TRANSFER (ta, 1);	1982	TRANSFER (ta, 1);
1767	return 1;	1983	return 1;
1768	}	1984	}
1769	else	1985	else
…		…
1812	coro->slot->runops = RUNOPS_DEFAULT;	2028	coro->slot->runops = RUNOPS_DEFAULT;
1813	}	2029	}
1814	}	2030	}
1815		2031
1816	static void	2032	static void
		2033	coro_push_av (pTHX_ AV *av, I32 gimme_v)
		2034	{
		2035	if (AvFILLp (av) >= 0 && gimme_v != G_VOID)
		2036	{
		2037	dSP;
		2038
		2039	if (gimme_v == G_SCALAR)
		2040	XPUSHs (AvARRAY (av)[AvFILLp (av)]);
		2041	else
		2042	{
		2043	int i;
		2044	EXTEND (SP, AvFILLp (av) + 1);
		2045
		2046	for (i = 0; i <= AvFILLp (av); ++i)
		2047	PUSHs (AvARRAY (av)[i]);
		2048	}
		2049
		2050	PUTBACK;
		2051	}
		2052	}
		2053
		2054	static void
		2055	coro_push_on_destroy (pTHX_ struct coro *coro, SV *cb)
		2056	{
		2057	if (!coro->on_destroy)
		2058	coro->on_destroy = newAV ();
		2059
		2060	av_push (coro->on_destroy, cb);
		2061	}
		2062
		2063	static void
		2064	slf_destroy_join (pTHX_ struct CoroSLF *frame)
		2065	{
		2066	SvREFCNT_dec ((SV *)((struct coro *)frame->data)->hv);
		2067	}
		2068
		2069	static int
		2070	slf_check_join (pTHX_ struct CoroSLF *frame)
		2071	{
		2072	struct coro *coro = (struct coro *)frame->data;
		2073
		2074	if (!coro->status)
		2075	return 1;
		2076
		2077	frame->destroy = 0;
		2078
		2079	coro_push_av (aTHX_ coro->status, GIMME_V);
		2080
		2081	SvREFCNT_dec ((SV *)coro->hv);
		2082
		2083	return 0;
		2084	}
		2085
		2086	static void
		2087	slf_init_join (pTHX_ struct CoroSLF *frame, CV *cv, SV **arg, int items)
		2088	{
		2089	struct coro *coro = SvSTATE (items > 0 ? arg [0] : &PL_sv_undef);
		2090
		2091	if (items > 1)
		2092	croak ("join called with too many arguments");
		2093
		2094	if (coro->status)
		2095	frame->prepare = prepare_nop;
		2096	else
		2097	{
		2098	coro_push_on_destroy (aTHX_ coro, SvREFCNT_inc_NN (SvRV (coro_current)));
		2099	frame->prepare = prepare_schedule;
		2100	}
		2101
		2102	frame->check = slf_check_join;
		2103	frame->destroy = slf_destroy_join;
		2104	frame->data = (void *)coro;
		2105	SvREFCNT_inc (coro->hv);
		2106	}
		2107
		2108	static void
1817	coro_call_on_destroy (pTHX_ struct coro *coro)	2109	coro_call_on_destroy (pTHX_ struct coro *coro)
1818	{	2110	{
1819	SV **on_destroyp = hv_fetch (coro->hv, "_on_destroy", sizeof ("_on_destroy") - 1, 0);	2111	AV *od = coro->on_destroy;
1820	SV **statusp = hv_fetch (coro->hv, "_status", sizeof ("_status") - 1, 0);
1821		2112
1822	if (on_destroyp)	2113	if (!od)
1823	{	2114	return;
1824	AV *on_destroy = (AV *)SvRV (*on_destroyp);
1825		2115
		2116	coro->on_destroy = 0;
		2117	sv_2mortal ((SV *)od);
		2118
1826	while (AvFILLp (on_destroy) >= 0)	2119	while (AvFILLp (od) >= 0)
		2120	{
		2121	SV *cb = sv_2mortal (av_pop (od));
		2122
		2123	/* coro hv's (and only hv's at the moment) are supported as well */
		2124	if (SvSTATEhv_p (aTHX_ cb))
		2125	api_ready (aTHX_ cb);
		2126	else
1827	{	2127	{
1828	dSP; /* don't disturb outer sp */	2128	dSP; /* don't disturb outer sp */
1829	SV *cb = av_pop (on_destroy);
1830
1831	PUSHMARK (SP);	2129	PUSHMARK (SP);
1832		2130
1833	if (statusp)	2131	if (coro->status)
1834	{	2132	{
1835	int i;	2133	PUTBACK;
1836	AV *status = (AV *)SvRV (*statusp);	2134	coro_push_av (aTHX_ coro->status, G_ARRAY);
1837	EXTEND (SP, AvFILLp (status) + 1);	2135	SPAGAIN;
1838
1839	for (i = 0; i <= AvFILLp (status); ++i)
1840	PUSHs (AvARRAY (status)[i]);
1841	}	2136	}
1842		2137
1843	PUTBACK;	2138	PUTBACK;
1844	call_sv (sv_2mortal (cb), G_VOID | G_DISCARD);	2139	call_sv (cb, G_VOID | G_DISCARD);
1845	}	2140	}
1846	}	2141	}
1847	}	2142	}
1848		2143
1849	static void	2144	static void
1850	slf_init_terminate (pTHX_ struct CoroSLF *frame, CV *cv, SV **arg, int items)	2145	coro_set_status (pTHX_ struct coro *coro, SV **arg, int items)
1851	{	2146	{
		2147	AV *av;
		2148
		2149	if (coro->status)
		2150	{
		2151	av = coro->status;
		2152	av_clear (av);
		2153	}
		2154	else
		2155	av = coro->status = newAV ();
		2156
		2157	/* items are actually not so common, so optimise for this case */
		2158	if (items)
		2159	{
1852	int i;	2160	int i;
1853	HV *hv = (HV *)SvRV (coro_current);
1854	AV *av = newAV ();
1855		2161
1856	av_extend (av, items - 1);	2162	av_extend (av, items - 1);
		2163
1857	for (i = 0; i < items; ++i)	2164	for (i = 0; i < items; ++i)
1858	av_push (av, SvREFCNT_inc_NN (arg [i]));	2165	av_push (av, SvREFCNT_inc_NN (arg [i]));
		2166	}
		2167	}
1859		2168
1860	hv_store (hv, "_status", sizeof ("_status") - 1, newRV_noinc ((SV *)av), 0);	2169	static void
1861		2170	slf_init_terminate_cancel_common (pTHX_ struct CoroSLF *frame, HV *coro_hv)
		2171	{
1862	av_push (av_destroy, (SV *)newRV_inc ((SV *)hv)); /* RVinc for perl */	2172	av_push (av_destroy, (SV *)newRV_inc ((SV *)coro_hv)); /* RVinc for perl */
1863	api_ready (aTHX_ sv_manager);	2173	api_ready (aTHX_ sv_manager);
1864		2174
1865	frame->prepare = prepare_schedule;	2175	frame->prepare = prepare_schedule;
1866	frame->check = slf_check_repeat;	2176	frame->check = slf_check_repeat;
		2177
		2178	/* as a minor optimisation, we could unwind all stacks here */
		2179	/* but that puts extra pressure on pp_slf, and is not worth much */
		2180	/*coro_unwind_stacks (aTHX);*/
		2181	}
		2182
		2183	static void
		2184	slf_init_terminate (pTHX_ struct CoroSLF *frame, CV *cv, SV **arg, int items)
		2185	{
		2186	HV *coro_hv = (HV *)SvRV (coro_current);
		2187
		2188	coro_set_status (aTHX_ SvSTATE ((SV *)coro_hv), arg, items);
		2189	slf_init_terminate_cancel_common (aTHX_ frame, coro_hv);
		2190	}
		2191
		2192	static void
		2193	slf_init_cancel (pTHX_ struct CoroSLF *frame, CV *cv, SV **arg, int items)
		2194	{
		2195	HV *coro_hv;
		2196	struct coro *coro;
		2197
		2198	if (items <= 0)
		2199	croak ("Coro::cancel called without coro object,");
		2200
		2201	coro = SvSTATE (arg [0]);
		2202	coro_hv = coro->hv;
		2203
		2204	coro_set_status (aTHX_ coro, arg + 1, items - 1);
		2205
		2206	if (ecb_expect_false (coro->flags & CF_NOCANCEL))
		2207	{
		2208	/* coro currently busy cancelling something, so just notify it */
		2209	coro->slf_frame.data = (void *)coro;
		2210
		2211	frame->prepare = prepare_nop;
		2212	frame->check = slf_check_nop;
		2213	}
		2214	else if (coro_hv == (HV *)SvRV (coro_current))
		2215	{
		2216	/* cancelling the current coro is allowed, and equals terminate */
		2217	slf_init_terminate_cancel_common (aTHX_ frame, coro_hv);
		2218	}
		2219	else
		2220	{
		2221	struct coro *self = SvSTATE_current;
		2222
		2223	/* otherwise we cancel directly, purely for speed reasons
		2224	* unfortunately, this requires some magic trickery, as
		2225	* somebody else could cancel us, so we have to fight the cancellation.
		2226	* this is ugly, and hopefully fully worth the extra speed.
		2227	* besides, I can't get the slow-but-safe version working...
		2228	*/
		2229	slf_frame.data = 0;
		2230	self->flags |= CF_NOCANCEL;
		2231	coro_state_destroy (aTHX_ coro);
		2232	self->flags &= ~CF_NOCANCEL;
		2233
		2234	if (slf_frame.data)
		2235	{
		2236	/* while we were busy we have been cancelled, so terminate */
		2237	slf_init_terminate_cancel_common (aTHX_ frame, self->hv);
		2238	}
		2239	else
		2240	{
		2241	frame->prepare = prepare_nop;
		2242	frame->check = slf_check_nop;
		2243	}
		2244	}
		2245	}
		2246
		2247	static int
		2248	slf_check_safe_cancel (pTHX_ struct CoroSLF *frame)
		2249	{
		2250	frame->prepare = 0;
		2251	coro_unwind_stacks (aTHX);
		2252
		2253	slf_init_terminate_cancel_common (aTHX_ frame, (HV *)SvRV (coro_current));
		2254
		2255	return 1;
		2256	}
		2257
		2258	static int
		2259	safe_cancel (pTHX_ struct coro *coro, SV **arg, int items)
		2260	{
		2261	if (coro->cctx)
		2262	croak ("coro inside C callback, unable to cancel at this time, caught");
		2263
		2264	if (coro->flags & CF_NEW)
		2265	{
		2266	coro_set_status (aTHX_ coro, arg, items);
		2267	coro_state_destroy (aTHX_ coro);
		2268	}
		2269	else
		2270	{
		2271	if (!coro->slf_frame.prepare)
		2272	croak ("coro outside an SLF function, unable to cancel at this time, caught");
		2273
		2274	slf_destroy (aTHX_ coro);
		2275
		2276	coro_set_status (aTHX_ coro, arg, items);
		2277	coro->slf_frame.prepare = prepare_nop;
		2278	coro->slf_frame.check = slf_check_safe_cancel;
		2279
		2280	api_ready (aTHX_ (SV *)coro->hv);
		2281	}
		2282
		2283	return 1;
1867	}	2284	}
1868		2285
1869	/*****************************************************************************/	2286	/*****************************************************************************/
1870	/* async pool handler */	2287	/* async pool handler */
1871		2288
…		…
1902	slf_init_pool_handler (pTHX_ struct CoroSLF *frame, CV *cv, SV **arg, int items)	2319	slf_init_pool_handler (pTHX_ struct CoroSLF *frame, CV *cv, SV **arg, int items)
1903	{	2320	{
1904	HV *hv = (HV *)SvRV (coro_current);	2321	HV *hv = (HV *)SvRV (coro_current);
1905	struct coro *coro = SvSTATE_hv ((SV *)hv);	2322	struct coro *coro = SvSTATE_hv ((SV *)hv);
1906		2323
1907	if (expect_true (coro->saved_deffh))	2324	if (ecb_expect_true (coro->saved_deffh))
1908	{	2325	{
1909	/* subsequent iteration */	2326	/* subsequent iteration */
1910	SvREFCNT_dec ((SV *)PL_defoutgv); PL_defoutgv = (GV *)coro->saved_deffh;	2327	SvREFCNT_dec ((SV *)PL_defoutgv); PL_defoutgv = (GV *)coro->saved_deffh;
1911	coro->saved_deffh = 0;	2328	coro->saved_deffh = 0;
1912		2329
1913	if (coro_rss (aTHX_ coro) > SvUV (sv_pool_rss)	2330	if (coro_rss (aTHX_ coro) > SvUV (sv_pool_rss)
1914	|| av_len (av_async_pool) + 1 >= SvIV (sv_pool_size))	2331	|| av_len (av_async_pool) + 1 >= SvIV (sv_pool_size))
1915	{	2332	{
1916	coro->invoke_cb = SvREFCNT_inc_NN ((SV *)cv_coro_terminate);	2333	slf_init_terminate_cancel_common (aTHX_ frame, hv);
1917	coro->invoke_av = newAV ();	2334	return;
1918
1919	frame->prepare = prepare_nop;
1920	}	2335	}
1921	else	2336	else
1922	{	2337	{
1923	av_clear (GvAV (PL_defgv));	2338	av_clear (GvAV (PL_defgv));
1924	hv_store (hv, "desc", sizeof ("desc") - 1, SvREFCNT_inc_NN (sv_async_pool_idle), 0);	2339	hv_store (hv, "desc", sizeof ("desc") - 1, SvREFCNT_inc_NN (sv_async_pool_idle), 0);
…		…
1949		2364
1950	static void	2365	static void
1951	coro_rouse_callback (pTHX_ CV *cv)	2366	coro_rouse_callback (pTHX_ CV *cv)
1952	{	2367	{
1953	dXSARGS;	2368	dXSARGS;
1954	SV *data = (SV *)GENSUB_ARG;	2369	SV *data = (SV *)S_GENSUB_ARG;
1955		2370
1956	if (SvTYPE (SvRV (data)) != SVt_PVAV)	2371	if (SvTYPE (SvRV (data)) != SVt_PVAV)
1957	{	2372	{
1958	/* first call, set args */	2373	/* first call, set args */
		2374	SV *coro = SvRV (data);
1959	AV *av = newAV ();	2375	AV *av = newAV ();
1960	SV *coro = SvRV (data);
1961		2376
1962	SvRV_set (data, (SV *)av);	2377	SvRV_set (data, (SV *)av);
1963	api_ready (aTHX_ coro);
1964	SvREFCNT_dec (coro);
1965		2378
1966	/* better take a full copy of the arguments */	2379	/* better take a full copy of the arguments */
1967	while (items--)	2380	while (items--)
1968	av_store (av, items, newSVsv (ST (items)));	2381	av_store (av, items, newSVsv (ST (items)));
		2382
		2383	api_ready (aTHX_ coro);
		2384	SvREFCNT_dec (coro);
1969	}	2385	}
1970		2386
1971	XSRETURN_EMPTY;	2387	XSRETURN_EMPTY;
1972	}	2388	}
1973		2389
1974	static int	2390	static int
1975	slf_check_rouse_wait (pTHX_ struct CoroSLF *frame)	2391	slf_check_rouse_wait (pTHX_ struct CoroSLF *frame)
1976	{	2392	{
1977	SV *data = (SV *)frame->data;	2393	SV *data = (SV *)frame->data;
1978		2394
1979	if (CORO_THROW)	2395	if (CORO_THROW)
1980	return 0;	2396	return 0;
1981		2397
1982	if (SvTYPE (SvRV (data)) != SVt_PVAV)	2398	if (SvTYPE (SvRV (data)) != SVt_PVAV)
1983	return 1;	2399	return 1;
…		…
1990		2406
1991	EXTEND (SP, AvFILLp (av) + 1);	2407	EXTEND (SP, AvFILLp (av) + 1);
1992	for (i = 0; i <= AvFILLp (av); ++i)	2408	for (i = 0; i <= AvFILLp (av); ++i)
1993	PUSHs (sv_2mortal (AvARRAY (av)[i]));	2409	PUSHs (sv_2mortal (AvARRAY (av)[i]));
1994		2410
1995	/* we have stolen the elements, so ste length to zero and free */	2411	/* we have stolen the elements, so set length to zero and free */
1996	AvFILLp (av) = -1;	2412	AvFILLp (av) = -1;
1997	av_undef (av);	2413	av_undef (av);
1998		2414
1999	PUTBACK;	2415	PUTBACK;
2000	}	2416	}
…		…
2019	cb = sv_2mortal (coro->rouse_cb);	2435	cb = sv_2mortal (coro->rouse_cb);
2020	coro->rouse_cb = 0;	2436	coro->rouse_cb = 0;
2021	}	2437	}
2022		2438
2023	if (!SvROK (cb)	2439	if (!SvROK (cb)
2024	|| SvTYPE (SvRV (cb)) != SVt_PVCV	2440	|| SvTYPE (SvRV (cb)) != SVt_PVCV
2025	|| CvXSUB ((CV *)SvRV (cb)) != coro_rouse_callback)	2441	|| CvXSUB ((CV *)SvRV (cb)) != coro_rouse_callback)
2026	croak ("Coro::rouse_wait called with illegal callback argument,");	2442	croak ("Coro::rouse_wait called with illegal callback argument,");
2027		2443
2028	{	2444	{
2029	CV *cv = (CV *)SvRV (cb); /* for GENSUB_ARG */	2445	CV *cv = (CV *)SvRV (cb); /* for S_GENSUB_ARG */
2030	SV *data = (SV *)GENSUB_ARG;	2446	SV *data = (SV *)S_GENSUB_ARG;
2031		2447
2032	frame->data = (void *)data;	2448	frame->data = (void *)data;
2033	frame->prepare = SvTYPE (SvRV (data)) == SVt_PVAV ? prepare_nop : prepare_schedule;	2449	frame->prepare = SvTYPE (SvRV (data)) == SVt_PVAV ? prepare_nop : prepare_schedule;
2034	frame->check = slf_check_rouse_wait;	2450	frame->check = slf_check_rouse_wait;
2035	}	2451	}
…		…
2039	coro_new_rouse_cb (pTHX)	2455	coro_new_rouse_cb (pTHX)
2040	{	2456	{
2041	HV *hv = (HV *)SvRV (coro_current);	2457	HV *hv = (HV *)SvRV (coro_current);
2042	struct coro *coro = SvSTATE_hv (hv);	2458	struct coro *coro = SvSTATE_hv (hv);
2043	SV *data = newRV_inc ((SV *)hv);	2459	SV *data = newRV_inc ((SV *)hv);
2044	SV *cb = gensub (aTHX_ coro_rouse_callback, (void *)data);	2460	SV *cb = s_gensub (aTHX_ coro_rouse_callback, (void *)data);
2045		2461
2046	sv_magicext (SvRV (cb), data, CORO_MAGIC_type_rouse, 0, 0, 0);	2462	sv_magicext (SvRV (cb), data, CORO_MAGIC_type_rouse, 0, 0, 0);
2047	SvREFCNT_dec (data); /* magicext increases the refcount */	2463	SvREFCNT_dec (data); /* magicext increases the refcount */
2048		2464
2049	SvREFCNT_dec (coro->rouse_cb);	2465	SvREFCNT_dec (coro->rouse_cb);
…		…
2146	static void	2562	static void
2147	slf_init_cede_notself (pTHX_ struct CoroSLF *frame, CV *cv, SV **arg, int items)	2563	slf_init_cede_notself (pTHX_ struct CoroSLF *frame, CV *cv, SV **arg, int items)
2148	{	2564	{
2149	frame->prepare = prepare_cede_notself;	2565	frame->prepare = prepare_cede_notself;
2150	frame->check = slf_check_nop;	2566	frame->check = slf_check_nop;
		2567	}
		2568
		2569	/* "undo"/cancel a running slf call - used when cancelling a coro, mainly */
		2570	static void
		2571	slf_destroy (pTHX_ struct coro *coro)
		2572	{
		2573	/* this callback is reserved for slf functions needing to do cleanup */
		2574	if (coro->slf_frame.destroy && coro->slf_frame.prepare && !PL_dirty)
		2575	coro->slf_frame.destroy (aTHX_ &coro->slf_frame);
		2576
		2577	/*
		2578	* The on_destroy above most likely is from an SLF call.
		2579	* Since by definition the SLF call will not finish when we destroy
		2580	* the coro, we will have to force-finish it here, otherwise
		2581	* cleanup functions cannot call SLF functions.
		2582	*/
		2583	coro->slf_frame.prepare = 0;
2151	}	2584	}
2152		2585
2153	/*	2586	/*
2154	* these not obviously related functions are all rolled into one	2587	* these not obviously related functions are all rolled into one
2155	* function to increase chances that they all will call transfer with the same	2588	* function to increase chances that they all will call transfer with the same
…		…
2162	I32 checkmark; /* mark SP to see how many elements check has pushed */	2595	I32 checkmark; /* mark SP to see how many elements check has pushed */
2163		2596
2164	/* set up the slf frame, unless it has already been set-up */	2597	/* set up the slf frame, unless it has already been set-up */
2165	/* the latter happens when a new coro has been started */	2598	/* the latter happens when a new coro has been started */
2166	/* or when a new cctx was attached to an existing coroutine */	2599	/* or when a new cctx was attached to an existing coroutine */
2167	if (expect_true (!slf_frame.prepare))	2600	if (ecb_expect_true (!slf_frame.prepare))
2168	{	2601	{
2169	/* first iteration */	2602	/* first iteration */
2170	dSP;	2603	dSP;
2171	SV **arg = PL_stack_base + TOPMARK + 1;	2604	SV **arg = PL_stack_base + TOPMARK + 1;
2172	int items = SP - arg; /* args without function object */	2605	int items = SP - arg; /* args without function object */
…		…
2213	while (slf_frame.check (aTHX_ &slf_frame));	2646	while (slf_frame.check (aTHX_ &slf_frame));
2214		2647
2215	slf_frame.prepare = 0; /* invalidate the frame, we are done processing it */	2648	slf_frame.prepare = 0; /* invalidate the frame, we are done processing it */
2216		2649
2217	/* exception handling */	2650	/* exception handling */
2218	if (expect_false (CORO_THROW))	2651	if (ecb_expect_false (CORO_THROW))
2219	{	2652	{
2220	SV *exception = sv_2mortal (CORO_THROW);	2653	SV *exception = sv_2mortal (CORO_THROW);
2221		2654
2222	CORO_THROW = 0;	2655	CORO_THROW = 0;
2223	sv_setsv (ERRSV, exception);	2656	sv_setsv (ERRSV, exception);
2224	croak (0);	2657	croak (0);
2225	}	2658	}
2226		2659
2227	/* return value handling - mostly like entersub */	2660	/* return value handling - mostly like entersub */
2228	/* make sure we put something on the stack in scalar context */	2661	/* make sure we put something on the stack in scalar context */
2229	if (GIMME_V == G_SCALAR)	2662	if (GIMME_V == G_SCALAR
		2663	&& ecb_expect_false (PL_stack_sp != PL_stack_base + checkmark + 1))
2230	{	2664	{
2231	dSP;	2665	dSP;
2232	SV **bot = PL_stack_base + checkmark;	2666	SV **bot = PL_stack_base + checkmark;
2233		2667
2234	if (sp == bot) /* too few, push undef */	2668	if (sp == bot) /* too few, push undef */
2235	bot [1] = &PL_sv_undef;	2669	bot [1] = &PL_sv_undef;
2236	else if (sp != bot + 1) /* too many, take last one */	2670	else /* too many, take last one */
2237	bot [1] = *sp;	2671	bot [1] = *sp;
2238		2672
2239	SP = bot + 1;	2673	SP = bot + 1;
2240		2674
2241	PUTBACK;	2675	PUTBACK;
…		…
2274	if (PL_op->op_flags & OPf_STACKED)	2708	if (PL_op->op_flags & OPf_STACKED)
2275	{	2709	{
2276	if (items > slf_arga)	2710	if (items > slf_arga)
2277	{	2711	{
2278	slf_arga = items;	2712	slf_arga = items;
2279	free (slf_argv);	2713	Safefree (slf_argv);
2280	slf_argv = malloc (slf_arga * sizeof (SV *));	2714	New (0, slf_argv, slf_arga, SV *);
2281	}	2715	}
2282		2716
2283	slf_argc = items;	2717	slf_argc = items;
2284		2718
2285	for (i = 0; i < items; ++i)	2719	for (i = 0; i < items; ++i)
…		…
2290		2724
2291	PL_op->op_ppaddr = pp_slf;	2725	PL_op->op_ppaddr = pp_slf;
2292	/*PL_op->op_type = OP_CUSTOM; /* we do behave like entersub still */	2726	/*PL_op->op_type = OP_CUSTOM; /* we do behave like entersub still */
2293		2727
2294	PL_op = (OP *)&slf_restore;	2728	PL_op = (OP *)&slf_restore;
		2729	}
		2730
		2731	/*****************************************************************************/
		2732	/* dynamic wind */
		2733
		2734	static void
		2735	on_enterleave_call (pTHX_ SV *cb)
		2736	{
		2737	dSP;
		2738
		2739	PUSHSTACK;
		2740
		2741	PUSHMARK (SP);
		2742	PUTBACK;
		2743	call_sv (cb, G_VOID | G_DISCARD);
		2744	SPAGAIN;
		2745
		2746	POPSTACK;
		2747	}
		2748
		2749	static SV *
		2750	coro_avp_pop_and_free (pTHX_ AV **avp)
		2751	{
		2752	AV *av = *avp;
		2753	SV *res = av_pop (av);
		2754
		2755	if (AvFILLp (av) < 0)
		2756	{
		2757	*avp = 0;
		2758	SvREFCNT_dec (av);
		2759	}
		2760
		2761	return res;
		2762	}
		2763
		2764	static void
		2765	coro_pop_on_enter (pTHX_ void *coro)
		2766	{
		2767	SV *cb = coro_avp_pop_and_free (aTHX_ &((struct coro *)coro)->on_enter);
		2768	SvREFCNT_dec (cb);
		2769	}
		2770
		2771	static void
		2772	coro_pop_on_leave (pTHX_ void *coro)
		2773	{
		2774	SV *cb = coro_avp_pop_and_free (aTHX_ &((struct coro *)coro)->on_leave);
		2775	on_enterleave_call (aTHX_ sv_2mortal (cb));
2295	}	2776	}
2296		2777
2297	/*****************************************************************************/	2778	/*****************************************************************************/
2298	/* PerlIO::cede */	2779	/* PerlIO::cede */
2299		2780
…		…
2301	{	2782	{
2302	PerlIOBuf base;	2783	PerlIOBuf base;
2303	NV next, every;	2784	NV next, every;
2304	} PerlIOCede;	2785	} PerlIOCede;
2305		2786
2306	static IV	2787	static IV ecb_cold
2307	PerlIOCede_pushed (pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab)	2788	PerlIOCede_pushed (pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab)
2308	{	2789	{
2309	PerlIOCede *self = PerlIOSelf (f, PerlIOCede);	2790	PerlIOCede *self = PerlIOSelf (f, PerlIOCede);
2310		2791
2311	self->every = SvCUR (arg) ? SvNV (arg) : 0.01;	2792	self->every = SvCUR (arg) ? SvNV (arg) : 0.01;
2312	self->next = nvtime () + self->every;	2793	self->next = nvtime () + self->every;
2313		2794
2314	return PerlIOBuf_pushed (aTHX_ f, mode, Nullsv, tab);	2795	return PerlIOBuf_pushed (aTHX_ f, mode, Nullsv, tab);
2315	}	2796	}
2316		2797
2317	static SV *	2798	static SV * ecb_cold
2318	PerlIOCede_getarg (pTHX_ PerlIO *f, CLONE_PARAMS *param, int flags)	2799	PerlIOCede_getarg (pTHX_ PerlIO *f, CLONE_PARAMS *param, int flags)
2319	{	2800	{
2320	PerlIOCede *self = PerlIOSelf (f, PerlIOCede);	2801	PerlIOCede *self = PerlIOSelf (f, PerlIOCede);
2321		2802
2322	return newSVnv (self->every);	2803	return newSVnv (self->every);
…		…
2373	/* Coro::Semaphore & Coro::Signal */	2854	/* Coro::Semaphore & Coro::Signal */
2374		2855
2375	static SV *	2856	static SV *
2376	coro_waitarray_new (pTHX_ int count)	2857	coro_waitarray_new (pTHX_ int count)
2377	{	2858	{
2378	/* a semaphore contains a counter IV in $sem->[0] and any waiters after that */	2859	/* a waitarray=semaphore contains a counter IV in $sem->[0] and any waiters after that */
2379	AV *av = newAV ();	2860	AV *av = newAV ();
2380	SV **ary;	2861	SV **ary;
2381		2862
2382	/* unfortunately, building manually saves memory */	2863	/* unfortunately, building manually saves memory */
2383	Newx (ary, 2, SV *);	2864	Newx (ary, 2, SV *);
…		…
2434	SvREFCNT_dec (cb);	2915	SvREFCNT_dec (cb);
2435	}	2916	}
2436	}	2917	}
2437		2918
2438	static void	2919	static void
2439	coro_semaphore_on_destroy (pTHX_ struct coro *coro)	2920	coro_semaphore_destroy (pTHX_ struct CoroSLF *frame)
2440	{	2921	{
2441	/* call $sem->adjust (0) to possibly wake up some other waiters */	2922	/* call $sem->adjust (0) to possibly wake up some other waiters */
2442	coro_semaphore_adjust (aTHX_ (AV *)coro->slf_frame.data, 0);	2923	coro_semaphore_adjust (aTHX_ (AV *)frame->data, 0);
2443	}	2924	}
2444		2925
2445	static int	2926	static int
2446	slf_check_semaphore_down_or_wait (pTHX_ struct CoroSLF *frame, int acquire)	2927	slf_check_semaphore_down_or_wait (pTHX_ struct CoroSLF *frame, int acquire)
2447	{	2928	{
2448	AV *av = (AV *)frame->data;	2929	AV *av = (AV *)frame->data;
2449	SV *count_sv = AvARRAY (av)[0];	2930	SV *count_sv = AvARRAY (av)[0];
		2931	SV *coro_hv = SvRV (coro_current);
2450		2932
2451	/* if we are about to throw, don't actually acquire the lock, just throw */	2933	/* if we are about to throw, don't actually acquire the lock, just throw */
2452	if (CORO_THROW)	2934	if (CORO_THROW)
2453	return 0;	2935	return 0;
2454	else if (SvIVX (count_sv) > 0)	2936	else if (SvIVX (count_sv) > 0)
2455	{	2937	{
2456	SvSTATE_current->on_destroy = 0;	2938	frame->destroy = 0;
2457		2939
2458	if (acquire)	2940	if (acquire)
2459	SvIVX (count_sv) = SvIVX (count_sv) - 1;	2941	SvIVX (count_sv) = SvIVX (count_sv) - 1;
2460	else	2942	else
2461	coro_semaphore_adjust (aTHX_ av, 0);	2943	coro_semaphore_adjust (aTHX_ av, 0);
…		…
2466	{	2948	{
2467	int i;	2949	int i;
2468	/* if we were woken up but can't down, we look through the whole */	2950	/* if we were woken up but can't down, we look through the whole */
2469	/* waiters list and only add us if we aren't in there already */	2951	/* waiters list and only add us if we aren't in there already */
2470	/* this avoids some degenerate memory usage cases */	2952	/* this avoids some degenerate memory usage cases */
2471		2953	for (i = AvFILLp (av); i > 0; --i) /* i > 0 is not an off-by-one bug */
2472	for (i = 1; i <= AvFILLp (av); ++i)
2473	if (AvARRAY (av)[i] == SvRV (coro_current))	2954	if (AvARRAY (av)[i] == coro_hv)
2474	return 1;	2955	return 1;
2475		2956
2476	av_push (av, SvREFCNT_inc (SvRV (coro_current)));	2957	av_push (av, SvREFCNT_inc (coro_hv));
2477	return 1;	2958	return 1;
2478	}	2959	}
2479	}	2960	}
2480		2961
2481	static int	2962	static int
…		…
2504	{	2985	{
2505	av_push (av, SvREFCNT_inc (SvRV (coro_current)));	2986	av_push (av, SvREFCNT_inc (SvRV (coro_current)));
2506		2987
2507	frame->data = (void *)sv_2mortal (SvREFCNT_inc ((SV *)av));	2988	frame->data = (void *)sv_2mortal (SvREFCNT_inc ((SV *)av));
2508	frame->prepare = prepare_schedule;	2989	frame->prepare = prepare_schedule;
2509
2510	/* to avoid race conditions when a woken-up coro gets terminated */	2990	/* to avoid race conditions when a woken-up coro gets terminated */
2511	/* we arrange for a temporary on_destroy that calls adjust (0) */	2991	/* we arrange for a temporary on_destroy that calls adjust (0) */
2512	SvSTATE_current->on_destroy = coro_semaphore_on_destroy;	2992	frame->destroy = coro_semaphore_destroy;
2513	}	2993	}
2514	}	2994	}
2515		2995
2516	static void	2996	static void
2517	slf_init_semaphore_down (pTHX_ struct CoroSLF *frame, CV *cv, SV **arg, int items)	2997	slf_init_semaphore_down (pTHX_ struct CoroSLF *frame, CV *cv, SV **arg, int items)
…		…
2525	{	3005	{
2526	if (items >= 2)	3006	if (items >= 2)
2527	{	3007	{
2528	/* callback form */	3008	/* callback form */
2529	AV *av = (AV *)SvRV (arg [0]);	3009	AV *av = (AV *)SvRV (arg [0]);
2530	CV *cb_cv = coro_sv_2cv (aTHX_ arg [1]);	3010	SV *cb_cv = s_get_cv_croak (arg [1]);
2531		3011
2532	av_push (av, (SV *)SvREFCNT_inc_NN (cb_cv));	3012	av_push (av, SvREFCNT_inc_NN (cb_cv));
2533		3013
2534	if (SvIVX (AvARRAY (av)[0]) > 0)	3014	if (SvIVX (AvARRAY (av)[0]) > 0)
2535	coro_semaphore_adjust (aTHX_ av, 0);	3015	coro_semaphore_adjust (aTHX_ av, 0);
2536		3016
2537	frame->prepare = prepare_nop;	3017	frame->prepare = prepare_nop;
…		…
2561	AvARRAY (av)[0] = AvARRAY (av)[1];	3041	AvARRAY (av)[0] = AvARRAY (av)[1];
2562	AvARRAY (av)[1] = cb;	3042	AvARRAY (av)[1] = cb;
2563		3043
2564	cb = av_shift (av);	3044	cb = av_shift (av);
2565		3045
		3046	if (SvTYPE (cb) == SVt_PVCV)
		3047	{
		3048	dSP;
		3049	PUSHMARK (SP);
		3050	XPUSHs (sv_2mortal (newRV_inc ((SV *)av)));
		3051	PUTBACK;
		3052	call_sv (cb, G_VOID | G_DISCARD | G_EVAL | G_KEEPERR);
		3053	}
		3054	else
		3055	{
2566	api_ready (aTHX_ cb);	3056	api_ready (aTHX_ cb);
2567	sv_setiv (cb, 0); /* signal waiter */	3057	sv_setiv (cb, 0); /* signal waiter */
		3058	}
		3059
2568	SvREFCNT_dec (cb);	3060	SvREFCNT_dec (cb);
2569		3061
2570	--count;	3062	--count;
2571	}	3063	}
2572	}	3064	}
…		…
2581	static void	3073	static void
2582	slf_init_signal_wait (pTHX_ struct CoroSLF *frame, CV *cv, SV **arg, int items)	3074	slf_init_signal_wait (pTHX_ struct CoroSLF *frame, CV *cv, SV **arg, int items)
2583	{	3075	{
2584	AV *av = (AV *)SvRV (arg [0]);	3076	AV *av = (AV *)SvRV (arg [0]);
2585		3077
		3078	if (items >= 2)
		3079	{
		3080	SV *cb_cv = s_get_cv_croak (arg [1]);
		3081	av_push (av, SvREFCNT_inc_NN (cb_cv));
		3082
2586	if (SvIVX (AvARRAY (av)[0]))	3083	if (SvIVX (AvARRAY (av)[0]))
		3084	coro_signal_wake (aTHX_ av, 1); /* must be the only waiter */
		3085
		3086	frame->prepare = prepare_nop;
		3087	frame->check = slf_check_nop;
		3088	}
		3089	else if (SvIVX (AvARRAY (av)[0]))
2587	{	3090	{
2588	SvIVX (AvARRAY (av)[0]) = 0;	3091	SvIVX (AvARRAY (av)[0]) = 0;
2589	frame->prepare = prepare_nop;	3092	frame->prepare = prepare_nop;
2590	frame->check = slf_check_nop;	3093	frame->check = slf_check_nop;
2591	}	3094	}
2592	else	3095	else
2593	{	3096	{
2594	SV *waiter = newRV_inc (SvRV (coro_current)); /* owned by signal av */	3097	SV *waiter = newSVsv (coro_current); /* owned by signal av */
2595		3098
2596	av_push (av, waiter);	3099	av_push (av, waiter);
2597		3100
2598	frame->data = (void *)sv_2mortal (SvREFCNT_inc_NN (waiter)); /* owned by process */	3101	frame->data = (void *)sv_2mortal (SvREFCNT_inc_NN (waiter)); /* owned by process */
2599	frame->prepare = prepare_schedule;	3102	frame->prepare = prepare_schedule;
…		…
2617		3120
2618	static void	3121	static void
2619	coro_aio_callback (pTHX_ CV *cv)	3122	coro_aio_callback (pTHX_ CV *cv)
2620	{	3123	{
2621	dXSARGS;	3124	dXSARGS;
2622	AV *state = (AV *)GENSUB_ARG;	3125	AV *state = (AV *)S_GENSUB_ARG;
2623	SV *coro = av_pop (state);	3126	SV *coro = av_pop (state);
2624	SV *data_sv = newSV (sizeof (struct io_state));	3127	SV *data_sv = newSV (sizeof (struct io_state));
2625		3128
2626	av_extend (state, items - 1);	3129	av_extend (state, items - 1);
2627		3130
…		…
2663	/* it quickly returns */	3166	/* it quickly returns */
2664	if (CORO_THROW)	3167	if (CORO_THROW)
2665	return 0;	3168	return 0;
2666		3169
2667	/* one element that is an RV? repeat! */	3170	/* one element that is an RV? repeat! */
2668	if (AvFILLp (state) == 0 && SvROK (AvARRAY (state)[0]))	3171	if (AvFILLp (state) == 0 && SvTYPE (AvARRAY (state)[0]) != SVt_PV)
2669	return 1;	3172	return 1;
2670		3173
2671	/* restore status */	3174	/* restore status */
2672	{	3175	{
2673	SV *data_sv = av_pop (state);	3176	SV *data_sv = av_pop (state);
…		…
2712	dSP;	3215	dSP;
2713		3216
2714	static SV *prio_cv;	3217	static SV *prio_cv;
2715	static SV *prio_sv;	3218	static SV *prio_sv;
2716		3219
2717	if (expect_false (!prio_cv))	3220	if (ecb_expect_false (!prio_cv))
2718	{	3221	{
2719	prio_cv = (SV *)get_cv ("IO::AIO::aioreq_pri", 0);	3222	prio_cv = (SV *)get_cv ("IO::AIO::aioreq_pri", 0);
2720	prio_sv = newSViv (0);	3223	prio_sv = newSViv (0);
2721	}	3224	}
2722		3225
…		…
2741		3244
2742	for (i = 0; i < items; ++i)	3245	for (i = 0; i < items; ++i)
2743	PUSHs (arg [i]);	3246	PUSHs (arg [i]);
2744		3247
2745	/* now push the callback closure */	3248	/* now push the callback closure */
2746	PUSHs (sv_2mortal (gensub (aTHX_ coro_aio_callback, (void *)SvREFCNT_inc_NN ((SV *)state))));	3249	PUSHs (sv_2mortal (s_gensub (aTHX_ coro_aio_callback, (void *)SvREFCNT_inc_NN ((SV *)state))));
2747		3250
2748	/* now call the AIO function - we assume our request is uncancelable */	3251	/* now call the AIO function - we assume our request is uncancelable */
2749	PUTBACK;	3252	PUTBACK;
2750	call_sv ((SV *)req, G_VOID | G_DISCARD);	3253	call_sv ((SV *)req, G_VOID | G_DISCARD);
2751	}	3254	}
2752		3255
2753	/* now that the requets is going, we loop toll we have a result */	3256	/* now that the request is going, we loop till we have a result */
2754	frame->data = (void *)state;	3257	frame->data = (void *)state;
2755	frame->prepare = prepare_schedule;	3258	frame->prepare = prepare_schedule;
2756	frame->check = slf_check_aio_req;	3259	frame->check = slf_check_aio_req;
2757	}	3260	}
2758		3261
…		…
2768		3271
2769	/*****************************************************************************/	3272	/*****************************************************************************/
2770		3273
2771	#if CORO_CLONE	3274	#if CORO_CLONE
2772	# include "clone.c"	3275	# include "clone.c"
		3276	#endif
		3277
		3278	/*****************************************************************************/
		3279
		3280	static SV *
		3281	coro_new (pTHX_ HV *stash, SV **argv, int argc, int is_coro)
		3282	{
		3283	SV *coro_sv;
		3284	struct coro *coro;
		3285	MAGIC *mg;
		3286	HV *hv;
		3287	SV *cb;
		3288	int i;
		3289
		3290	if (argc > 0)
		3291	{
		3292	cb = s_get_cv_croak (argv [0]);
		3293
		3294	if (!is_coro)
		3295	{
		3296	if (CvISXSUB (cb))
		3297	croak ("Coro::State doesn't support XS functions as coroutine start, caught");
		3298
		3299	if (!CvROOT (cb))
		3300	croak ("Coro::State doesn't support autoloaded or undefined functions as coroutine start, caught");
		3301	}
		3302	}
		3303
		3304	Newz (0, coro, 1, struct coro);
		3305	coro->args = newAV ();
		3306	coro->flags = CF_NEW;
		3307
		3308	if (coro_first) coro_first->prev = coro;
		3309	coro->next = coro_first;
		3310	coro_first = coro;
		3311
		3312	coro->hv = hv = newHV ();
		3313	mg = sv_magicext ((SV *)hv, 0, CORO_MAGIC_type_state, &coro_state_vtbl, (char *)coro, 0);
		3314	mg->mg_flags |= MGf_DUP;
		3315	coro_sv = sv_bless (newRV_noinc ((SV *)hv), stash);
		3316
		3317	if (argc > 0)
		3318	{
		3319	av_extend (coro->args, argc + is_coro - 1);
		3320
		3321	if (is_coro)
		3322	{
		3323	av_push (coro->args, SvREFCNT_inc_NN ((SV *)cb));
		3324	cb = (SV *)cv_coro_run;
		3325	}
		3326
		3327	coro->startcv = (CV *)SvREFCNT_inc_NN ((SV *)cb);
		3328
		3329	for (i = 1; i < argc; i++)
		3330	av_push (coro->args, newSVsv (argv [i]));
		3331	}
		3332
		3333	return coro_sv;
		3334	}
		3335
		3336	#ifndef __cplusplus
		3337	ecb_cold XS(boot_Coro__State);
		3338	#endif
		3339
		3340	#if CORO_JIT
		3341
		3342	static void ecb_noinline ecb_cold
		3343	pushav_4uv (pTHX_ UV a, UV b, UV c, UV d)
		3344	{
		3345	dSP;
		3346	AV *av = newAV ();
		3347
		3348	av_store (av, 3, newSVuv (d));
		3349	av_store (av, 2, newSVuv (c));
		3350	av_store (av, 1, newSVuv (b));
		3351	av_store (av, 0, newSVuv (a));
		3352
		3353	XPUSHs (sv_2mortal (newRV_noinc ((SV *)av)));
		3354
		3355	PUTBACK;
		3356	}
		3357
		3358	static void ecb_noinline ecb_cold
		3359	jit_init (pTHX)
		3360	{
		3361	dSP;
		3362	SV *load, *save;
		3363	char *map_base;
		3364	char *load_ptr, *save_ptr;
		3365	STRLEN load_len, save_len, map_len;
		3366	int count;
		3367
		3368	eval_pv ("require 'Coro/jit-" CORO_JIT_TYPE ".pl'", 1);
		3369
		3370	PUSHMARK (SP);
		3371	#define VARx(name,expr,type) pushav_4uv (aTHX_ (UV)&(expr), sizeof (expr), offsetof (perl_slots, name), sizeof (type));
		3372	#include "state.h"
		3373	count = call_pv ("Coro::State::_jit", G_ARRAY);
		3374	SPAGAIN;
		3375
		3376	save = POPs; save_ptr = SvPVbyte (save, save_len);
		3377	load = POPs; load_ptr = SvPVbyte (load, load_len);
		3378
		3379	map_len = load_len + save_len + 16;
		3380
		3381	map_base = mmap (0, map_len, PROT_READ | PROT_WRITE | PROT_EXEC, MAP_PRIVATE | MAP_ANONYMOUS, -1, 0);
		3382
		3383	assert (("Coro: unable to mmap jit code page, cannot continue.", map_base != (char *)MAP_FAILED));
		3384
		3385	load_perl_slots = (load_save_perl_slots_type)map_base;
		3386	memcpy (map_base, load_ptr, load_len);
		3387
		3388	map_base += (load_len + 15) & ~15;
		3389
		3390	save_perl_slots = (load_save_perl_slots_type)map_base;
		3391	memcpy (map_base, save_ptr, save_len);
		3392
		3393	/* we are good citizens and try to make the page read-only, so the evil evil */
		3394	/* hackers might have it a bit more difficult */
		3395	mprotect (map_base, map_len, PROT_READ | PROT_EXEC);
		3396
		3397	PUTBACK;
		3398	eval_pv ("undef &Coro::State::_jit", 1);
		3399	}
		3400
2773	#endif	3401	#endif
2774		3402
2775	MODULE = Coro::State PACKAGE = Coro::State PREFIX = api_	3403	MODULE = Coro::State PACKAGE = Coro::State PREFIX = api_
2776		3404
2777	PROTOTYPES: DISABLE	3405	PROTOTYPES: DISABLE
…		…
2781	#ifdef USE_ITHREADS	3409	#ifdef USE_ITHREADS
2782	# if CORO_PTHREAD	3410	# if CORO_PTHREAD
2783	coro_thx = PERL_GET_CONTEXT;	3411	coro_thx = PERL_GET_CONTEXT;
2784	# endif	3412	# endif
2785	#endif	3413	#endif
2786	BOOT_PAGESIZE;	3414	/* perl defines these to check for existance first, but why it doesn't */
		3415	/* just create them one at init time is not clear to me, except for */
		3416	/* programs trying to delete them, but... */
		3417	/* anyway, we declare this as invalid and make sure they are initialised here */
		3418	DEFSV;
		3419	ERRSV;
2787		3420
2788	cctx_current = cctx_new_empty ();	3421	cctx_current = cctx_new_empty ();
2789		3422
2790	irsgv = gv_fetchpv ("/" , GV_ADD|GV_NOTQUAL, SVt_PV);	3423	irsgv = gv_fetchpv ("/" , GV_ADD|GV_NOTQUAL, SVt_PV);
2791	stdoutgv = gv_fetchpv ("STDOUT", GV_ADD|GV_NOTQUAL, SVt_PVIO);	3424	stdoutgv = gv_fetchpv ("STDOUT", GV_ADD|GV_NOTQUAL, SVt_PVIO);
…		…
2831	coroapi.prepare_nop = prepare_nop;	3464	coroapi.prepare_nop = prepare_nop;
2832	coroapi.prepare_schedule = prepare_schedule;	3465	coroapi.prepare_schedule = prepare_schedule;
2833	coroapi.prepare_cede = prepare_cede;	3466	coroapi.prepare_cede = prepare_cede;
2834	coroapi.prepare_cede_notself = prepare_cede_notself;	3467	coroapi.prepare_cede_notself = prepare_cede_notself;
2835		3468
2836	{	3469	time_init (aTHX);
2837	SV **svp = hv_fetch (PL_modglobal, "Time::NVtime", 12, 0);
2838		3470
2839	if (!svp) croak ("Time::HiRes is required");
2840	if (!SvIOK (*svp)) croak ("Time::NVtime isn't a function pointer");
2841
2842	nvtime = INT2PTR (double (*)(), SvIV (*svp));
2843	}
2844
2845	assert (("PRIO_NORMAL must be 0", !PRIO_NORMAL));	3471	assert (("PRIO_NORMAL must be 0", !CORO_PRIO_NORMAL));
		3472	#if CORO_JIT
		3473	PUTBACK;
		3474	jit_init (aTHX);
		3475	SPAGAIN;
		3476	#endif
2846	}	3477	}
2847		3478
2848	SV *	3479	SV *
2849	new (char *klass, ...)	3480	new (SV *klass, ...)
2850	ALIAS:	3481	ALIAS:
2851	Coro::new = 1	3482	Coro::new = 1
2852	CODE:	3483	CODE:
2853	{	3484	RETVAL = coro_new (aTHX_ ix ? coro_stash : coro_state_stash, &ST (1), items - 1, ix);
2854	struct coro *coro;	3485	OUTPUT:
2855	MAGIC *mg;
2856	HV *hv;
2857	CV *cb;
2858	int i;
2859
2860	if (items > 1)
2861	{
2862	cb = coro_sv_2cv (aTHX_ ST (1));
2863
2864	if (!ix)
2865	{
2866	if (CvISXSUB (cb))
2867	croak ("Coro::State doesn't support XS functions as coroutine start, caught");
2868
2869	if (!CvROOT (cb))
2870	croak ("Coro::State doesn't support autoloaded or undefined functions as coroutine start, caught");
2871	}
2872	}
2873
2874	Newz (0, coro, 1, struct coro);
2875	coro->args = newAV ();
2876	coro->flags = CF_NEW;
2877
2878	if (coro_first) coro_first->prev = coro;
2879	coro->next = coro_first;
2880	coro_first = coro;
2881
2882	coro->hv = hv = newHV ();
2883	mg = sv_magicext ((SV *)hv, 0, CORO_MAGIC_type_state, &coro_state_vtbl, (char *)coro, 0);
2884	mg->mg_flags |= MGf_DUP;
2885	RETVAL = sv_bless (newRV_noinc ((SV *)hv), gv_stashpv (klass, 1));
2886
2887	if (items > 1)
2888	{
2889	av_extend (coro->args, items - 1 + ix - 1);
2890
2891	if (ix)
2892	{
2893	av_push (coro->args, SvREFCNT_inc_NN ((SV *)cb));
2894	cb = cv_coro_run;
2895	}
2896
2897	coro->startcv = (CV *)SvREFCNT_inc_NN ((SV *)cb);
2898
2899	for (i = 2; i < items; i++)
2900	av_push (coro->args, newSVsv (ST (i)));
2901	}
2902	}
2903	OUTPUT:
2904	RETVAL	3486	RETVAL
2905		3487
2906	void	3488	void
2907	transfer (...)	3489	transfer (...)
2908	PROTOTYPE: $$	3490	PROTOTYPE: $$
2909	CODE:	3491	CODE:
2910	CORO_EXECUTE_SLF_XS (slf_init_transfer);	3492	CORO_EXECUTE_SLF_XS (slf_init_transfer);
2911		3493
2912	bool
2913	_destroy (SV *coro_sv)
2914	CODE:
2915	RETVAL = coro_state_destroy (aTHX_ SvSTATE (coro_sv));
2916	OUTPUT:
2917	RETVAL
2918
2919	void
2920	_exit (int code)
2921	PROTOTYPE: $
2922	CODE:
2923	_exit (code);
2924
2925	SV *	3494	SV *
2926	clone (Coro::State coro)	3495	clone (Coro::State coro)
2927	CODE:	3496	CODE:
2928	{	3497	{
2929	#if CORO_CLONE	3498	#if CORO_CLONE
2930	struct coro *ncoro = coro_clone (coro);	3499	struct coro *ncoro = coro_clone (aTHX_ coro);
2931	MAGIC *mg;	3500	MAGIC *mg;
2932	/* TODO: too much duplication */	3501	/* TODO: too much duplication */
2933	ncoro->hv = newHV ();	3502	ncoro->hv = newHV ();
2934	mg = sv_magicext ((SV *)ncoro->hv, 0, CORO_MAGIC_type_state, &coro_state_vtbl, (char *)ncoro, 0);	3503	mg = sv_magicext ((SV *)ncoro->hv, 0, CORO_MAGIC_type_state, &coro_state_vtbl, (char *)ncoro, 0);
2935	mg->mg_flags |= MGf_DUP;	3504	mg->mg_flags |= MGf_DUP;
…		…
2983	void	3552	void
2984	list ()	3553	list ()
2985	PROTOTYPE:	3554	PROTOTYPE:
2986	PPCODE:	3555	PPCODE:
2987	{	3556	{
2988	struct coro *coro;	3557	struct coro *coro;
2989	for (coro = coro_first; coro; coro = coro->next)	3558	for (coro = coro_first; coro; coro = coro->next)
2990	if (coro->hv)	3559	if (coro->hv)
2991	XPUSHs (sv_2mortal (newRV_inc ((SV *)coro->hv)));	3560	XPUSHs (sv_2mortal (newRV_inc ((SV *)coro->hv)));
2992	}	3561	}
2993		3562
…		…
2997	eval = 1	3566	eval = 1
2998	CODE:	3567	CODE:
2999	{	3568	{
3000	if (coro->mainstack && ((coro->flags & CF_RUNNING) || coro->slot))	3569	if (coro->mainstack && ((coro->flags & CF_RUNNING) || coro->slot))
3001	{	3570	{
3002	struct coro temp;	3571	struct coro *current = SvSTATE_current;
		3572	struct CoroSLF slf_save;
3003		3573
3004	if (!(coro->flags & CF_RUNNING))	3574	if (current != coro)
3005	{	3575	{
3006	PUTBACK;	3576	PUTBACK;
3007	save_perl (aTHX_ &temp);	3577	save_perl (aTHX_ current);
3008	load_perl (aTHX_ coro);	3578	load_perl (aTHX_ coro);
		3579	/* the coro is most likely in an active SLF call.
		3580	* while not strictly required (the code we execute is
		3581	* not allowed to call any SLF functions), it's cleaner
		3582	* to reinitialise the slf_frame and restore it later.
		3583	* This might one day allow us to actually do SLF calls
		3584	* from code executed here.
		3585	*/
		3586	slf_save = slf_frame;
		3587	slf_frame.prepare = 0;
		3588	SPAGAIN;
3009	}	3589	}
3010		3590
3011	{
3012	dSP;
3013	ENTER;
3014	SAVETMPS;
3015	PUTBACK;
3016	PUSHSTACK;	3591	PUSHSTACK;
		3592
3017	PUSHMARK (SP);	3593	PUSHMARK (SP);
		3594	PUTBACK;
3018		3595
3019	if (ix)	3596	if (ix)
3020	eval_sv (coderef, 0);	3597	eval_sv (coderef, 0);
3021	else	3598	else
3022	call_sv (coderef, G_KEEPERR | G_EVAL | G_VOID | G_DISCARD);	3599	call_sv (coderef, G_KEEPERR | G_EVAL | G_VOID | G_DISCARD);
3023		3600
3024	POPSTACK;	3601	POPSTACK;
3025	SPAGAIN;	3602	SPAGAIN;
3026	FREETMPS;
3027	LEAVE;
3028	PUTBACK;
3029	}
3030		3603
3031	if (!(coro->flags & CF_RUNNING))	3604	if (current != coro)
3032	{	3605	{
		3606	PUTBACK;
		3607	slf_frame = slf_save;
3033	save_perl (aTHX_ coro);	3608	save_perl (aTHX_ coro);
3034	load_perl (aTHX_ &temp);	3609	load_perl (aTHX_ current);
3035	SPAGAIN;	3610	SPAGAIN;
3036	}	3611	}
3037	}	3612	}
3038	}	3613	}
3039		3614
…		…
3042	PROTOTYPE: $	3617	PROTOTYPE: $
3043	ALIAS:	3618	ALIAS:
3044	is_ready = CF_READY	3619	is_ready = CF_READY
3045	is_running = CF_RUNNING	3620	is_running = CF_RUNNING
3046	is_new = CF_NEW	3621	is_new = CF_NEW
3047	is_destroyed = CF_DESTROYED	3622	is_destroyed = CF_ZOMBIE
		3623	is_zombie = CF_ZOMBIE
		3624	is_suspended = CF_SUSPENDED
3048	CODE:	3625	CODE:
3049	RETVAL = boolSV (coro->flags & ix);	3626	RETVAL = boolSV (coro->flags & ix);
3050	OUTPUT:	3627	OUTPUT:
3051	RETVAL	3628	RETVAL
3052		3629
3053	void	3630	void
3054	throw (Coro::State self, SV *throw = &PL_sv_undef)	3631	throw (SV *self, SV *exception = &PL_sv_undef)
3055	PROTOTYPE: $;$	3632	PROTOTYPE: $;$
3056	CODE:	3633	CODE:
3057	{	3634	{
		3635	struct coro *coro = SvSTATE (self);
3058	struct coro *current = SvSTATE_current;	3636	struct coro *current = SvSTATE_current;
3059	SV **throwp = self == current ? &CORO_THROW : &self->except;	3637	SV **exceptionp = coro == current ? &CORO_THROW : &coro->except;
3060	SvREFCNT_dec (*throwp);	3638	SvREFCNT_dec (*exceptionp);
3061	*throwp = SvOK (throw) ? newSVsv (throw) : 0;	3639	SvGETMAGIC (exception);
		3640	*exceptionp = SvOK (exception) ? newSVsv (exception) : 0;
		3641
		3642	api_ready (aTHX_ self);
3062	}	3643	}
3063		3644
3064	void	3645	void
3065	api_trace (SV *coro, int flags = CC_TRACE | CC_TRACE_SUB)	3646	api_trace (SV *coro, int flags = CC_TRACE | CC_TRACE_SUB)
3066	PROTOTYPE: $;$	3647	PROTOTYPE: $;$
…		…
3117	SV **dst = ix ? (SV **)&self->slot->defav : (SV **)&self->slot->defsv;	3698	SV **dst = ix ? (SV **)&self->slot->defav : (SV **)&self->slot->defsv;
3118		3699
3119	SV *tmp = *src; *src = *dst; *dst = tmp;	3700	SV *tmp = *src; *src = *dst; *dst = tmp;
3120	}	3701	}
3121		3702
		3703	void
		3704	cancel (Coro::State self)
		3705	CODE:
		3706	coro_state_destroy (aTHX_ self);
		3707
		3708	SV *
		3709	enable_times (int enabled = enable_times)
		3710	CODE:
		3711	{
		3712	RETVAL = boolSV (enable_times);
		3713
		3714	if (enabled != enable_times)
		3715	{
		3716	enable_times = enabled;
		3717
		3718	coro_times_update ();
		3719	(enabled ? coro_times_sub : coro_times_add)(SvSTATE (coro_current));
		3720	}
		3721	}
		3722	OUTPUT:
		3723	RETVAL
		3724
		3725	void
		3726	times (Coro::State self)
		3727	PPCODE:
		3728	{
		3729	struct coro *current = SvSTATE (coro_current);
		3730
		3731	if (ecb_expect_false (current == self))
		3732	{
		3733	coro_times_update ();
		3734	coro_times_add (SvSTATE (coro_current));
		3735	}
		3736
		3737	EXTEND (SP, 2);
		3738	PUSHs (sv_2mortal (newSVnv (self->t_real [0] + self->t_real [1] * 1e-9)));
		3739	PUSHs (sv_2mortal (newSVnv (self->t_cpu [0] + self->t_cpu [1] * 1e-9)));
		3740
		3741	if (ecb_expect_false (current == self))
		3742	coro_times_sub (SvSTATE (coro_current));
		3743	}
		3744
		3745	void
		3746	swap_sv (Coro::State coro, SV *sv, SV *swapsv)
		3747	CODE:
		3748	{
		3749	struct coro *current = SvSTATE_current;
		3750
		3751	if (current == coro)
		3752	SWAP_SVS (current);
		3753
		3754	if (!coro->swap_sv)
		3755	coro->swap_sv = newAV ();
		3756
		3757	av_push (coro->swap_sv, SvREFCNT_inc_NN (SvRV (sv )));
		3758	av_push (coro->swap_sv, SvREFCNT_inc_NN (SvRV (swapsv)));
		3759
		3760	if (current == coro)
		3761	SWAP_SVS (current);
		3762	}
		3763
3122		3764
3123	MODULE = Coro::State PACKAGE = Coro	3765	MODULE = Coro::State PACKAGE = Coro
3124		3766
3125	BOOT:	3767	BOOT:
3126	{	3768	{
3127	int i;
3128
3129	sv_pool_rss = coro_get_sv (aTHX_ "Coro::POOL_RSS" , TRUE);	3769	sv_pool_rss = coro_get_sv (aTHX_ "Coro::POOL_RSS" , TRUE);
3130	sv_pool_size = coro_get_sv (aTHX_ "Coro::POOL_SIZE" , TRUE);	3770	sv_pool_size = coro_get_sv (aTHX_ "Coro::POOL_SIZE" , TRUE);
3131	cv_coro_run = get_cv ( "Coro::_terminate", GV_ADD);	3771	cv_coro_run = get_cv ( "Coro::_coro_run" , GV_ADD);
3132	cv_coro_terminate = get_cv ( "Coro::terminate" , GV_ADD);
3133	coro_current = coro_get_sv (aTHX_ "Coro::current" , FALSE); SvREADONLY_on (coro_current);	3772	coro_current = coro_get_sv (aTHX_ "Coro::current" , FALSE); SvREADONLY_on (coro_current);
3134	av_async_pool = coro_get_av (aTHX_ "Coro::async_pool", TRUE);	3773	av_async_pool = coro_get_av (aTHX_ "Coro::async_pool", TRUE);
3135	av_destroy = coro_get_av (aTHX_ "Coro::destroy" , TRUE);	3774	av_destroy = coro_get_av (aTHX_ "Coro::destroy" , TRUE);
3136	sv_manager = coro_get_sv (aTHX_ "Coro::manager" , TRUE);	3775	sv_manager = coro_get_sv (aTHX_ "Coro::manager" , TRUE);
3137	sv_idle = coro_get_sv (aTHX_ "Coro::idle" , TRUE);	3776	sv_idle = coro_get_sv (aTHX_ "Coro::idle" , TRUE);
3138		3777
3139	sv_async_pool_idle = newSVpv ("[async pool idle]", 0); SvREADONLY_on (sv_async_pool_idle);	3778	sv_async_pool_idle = newSVpv ("[async pool idle]", 0); SvREADONLY_on (sv_async_pool_idle);
3140	sv_Coro = newSVpv ("Coro", 0); SvREADONLY_on (sv_Coro);	3779	sv_Coro = newSVpv ("Coro", 0); SvREADONLY_on (sv_Coro);
3141	cv_pool_handler = get_cv ("Coro::pool_handler", GV_ADD); SvREADONLY_on (cv_pool_handler);	3780	cv_pool_handler = get_cv ("Coro::pool_handler", GV_ADD); SvREADONLY_on (cv_pool_handler);
3142	cv_coro_state_new = get_cv ("Coro::State::new", 0); SvREADONLY_on (cv_coro_state_new);	3781	CvNODEBUG_on (get_cv ("Coro::_pool_handler", 0)); /* work around a debugger bug */
3143		3782
3144	coro_stash = gv_stashpv ("Coro", TRUE);	3783	coro_stash = gv_stashpv ("Coro", TRUE);
3145		3784
3146	newCONSTSUB (coro_stash, "PRIO_MAX", newSViv (PRIO_MAX));	3785	newCONSTSUB (coro_stash, "PRIO_MAX", newSViv (CORO_PRIO_MAX));
3147	newCONSTSUB (coro_stash, "PRIO_HIGH", newSViv (PRIO_HIGH));	3786	newCONSTSUB (coro_stash, "PRIO_HIGH", newSViv (CORO_PRIO_HIGH));
3148	newCONSTSUB (coro_stash, "PRIO_NORMAL", newSViv (PRIO_NORMAL));	3787	newCONSTSUB (coro_stash, "PRIO_NORMAL", newSViv (CORO_PRIO_NORMAL));
3149	newCONSTSUB (coro_stash, "PRIO_LOW", newSViv (PRIO_LOW));	3788	newCONSTSUB (coro_stash, "PRIO_LOW", newSViv (CORO_PRIO_LOW));
3150	newCONSTSUB (coro_stash, "PRIO_IDLE", newSViv (PRIO_IDLE));	3789	newCONSTSUB (coro_stash, "PRIO_IDLE", newSViv (CORO_PRIO_IDLE));
3151	newCONSTSUB (coro_stash, "PRIO_MIN", newSViv (PRIO_MIN));	3790	newCONSTSUB (coro_stash, "PRIO_MIN", newSViv (CORO_PRIO_MIN));
3152
3153	for (i = PRIO_MAX - PRIO_MIN + 1; i--; )
3154	coro_ready[i] = newAV ();
3155		3791
3156	{	3792	{
3157	SV *sv = coro_get_sv (aTHX_ "Coro::API", TRUE);	3793	SV *sv = coro_get_sv (aTHX_ "Coro::API", TRUE);
3158		3794
3159	coroapi.schedule = api_schedule;	3795	coroapi.schedule = api_schedule;
…		…
3169	sv_setiv (sv, (IV)&coroapi);	3805	sv_setiv (sv, (IV)&coroapi);
3170	SvREADONLY_on (sv);	3806	SvREADONLY_on (sv);
3171	}	3807	}
3172	}	3808	}
3173		3809
		3810	SV *
		3811	async (...)
		3812	PROTOTYPE: &@
		3813	CODE:
		3814	RETVAL = coro_new (aTHX_ coro_stash, &ST (0), items, 1);
		3815	api_ready (aTHX_ RETVAL);
		3816	OUTPUT:
		3817	RETVAL
		3818
		3819	void
		3820	_destroy (Coro::State coro)
		3821	CODE:
		3822	/* used by the manager thread */
		3823	coro_state_destroy (aTHX_ coro);
		3824
		3825	void
		3826	on_destroy (Coro::State coro, SV *cb)
		3827	CODE:
		3828	coro_push_on_destroy (aTHX_ coro, newSVsv (cb));
		3829
		3830	void
		3831	join (...)
		3832	CODE:
		3833	CORO_EXECUTE_SLF_XS (slf_init_join);
		3834
3174	void	3835	void
3175	terminate (...)	3836	terminate (...)
3176	CODE:	3837	CODE:
3177	CORO_EXECUTE_SLF_XS (slf_init_terminate);	3838	CORO_EXECUTE_SLF_XS (slf_init_terminate);
3178		3839
3179	void	3840	void
		3841	cancel (...)
		3842	CODE:
		3843	CORO_EXECUTE_SLF_XS (slf_init_cancel);
		3844
		3845	int
		3846	safe_cancel (Coro::State self, ...)
		3847	C_ARGS: aTHX_ self, &ST (1), items - 1
		3848
		3849	void
3180	schedule (...)	3850	schedule (...)
3181	CODE:	3851	CODE:
3182	CORO_EXECUTE_SLF_XS (slf_init_schedule);	3852	CORO_EXECUTE_SLF_XS (slf_init_schedule);
3183		3853
3184	void	3854	void
…		…
3198		3868
3199	void	3869	void
3200	cede_notself (...)	3870	cede_notself (...)
3201	CODE:	3871	CODE:
3202	CORO_EXECUTE_SLF_XS (slf_init_cede_notself);	3872	CORO_EXECUTE_SLF_XS (slf_init_cede_notself);
3203
3204	void
3205	_cancel (Coro::State self)
3206	CODE:
3207	coro_state_destroy (aTHX_ self);
3208	coro_call_on_destroy (aTHX_ self);
3209		3873
3210	void	3874	void
3211	_set_current (SV *current)	3875	_set_current (SV *current)
3212	PROTOTYPE: $	3876	PROTOTYPE: $
3213	CODE:	3877	CODE:
…		…
3217	void	3881	void
3218	_set_readyhook (SV *hook)	3882	_set_readyhook (SV *hook)
3219	PROTOTYPE: $	3883	PROTOTYPE: $
3220	CODE:	3884	CODE:
3221	SvREFCNT_dec (coro_readyhook);	3885	SvREFCNT_dec (coro_readyhook);
		3886	SvGETMAGIC (hook);
		3887	if (SvOK (hook))
		3888	{
3222	coro_readyhook = SvOK (hook) ? newSVsv (hook) : 0;	3889	coro_readyhook = newSVsv (hook);
		3890	CORO_READYHOOK = invoke_sv_ready_hook_helper;
		3891	}
		3892	else
		3893	{
		3894	coro_readyhook = 0;
		3895	CORO_READYHOOK = 0;
		3896	}
3223		3897
3224	int	3898	int
3225	prio (Coro::State coro, int newprio = 0)	3899	prio (Coro::State coro, int newprio = 0)
3226	PROTOTYPE: $;$	3900	PROTOTYPE: $;$
3227	ALIAS:	3901	ALIAS:
…		…
3233	if (items > 1)	3907	if (items > 1)
3234	{	3908	{
3235	if (ix)	3909	if (ix)
3236	newprio = coro->prio - newprio;	3910	newprio = coro->prio - newprio;
3237		3911
3238	if (newprio < PRIO_MIN) newprio = PRIO_MIN;	3912	if (newprio < CORO_PRIO_MIN) newprio = CORO_PRIO_MIN;
3239	if (newprio > PRIO_MAX) newprio = PRIO_MAX;	3913	if (newprio > CORO_PRIO_MAX) newprio = CORO_PRIO_MAX;
3240		3914
3241	coro->prio = newprio;	3915	coro->prio = newprio;
3242	}	3916	}
3243	}	3917	}
3244	OUTPUT:	3918	OUTPUT:
…		…
3259	RETVAL = coro_nready;	3933	RETVAL = coro_nready;
3260	OUTPUT:	3934	OUTPUT:
3261	RETVAL	3935	RETVAL
3262		3936
3263	void	3937	void
		3938	suspend (Coro::State self)
		3939	PROTOTYPE: $
		3940	CODE:
		3941	self->flags |= CF_SUSPENDED;
		3942
		3943	void
		3944	resume (Coro::State self)
		3945	PROTOTYPE: $
		3946	CODE:
		3947	self->flags &= ~CF_SUSPENDED;
		3948
		3949	void
3264	_pool_handler (...)	3950	_pool_handler (...)
3265	CODE:	3951	CODE:
3266	CORO_EXECUTE_SLF_XS (slf_init_pool_handler);	3952	CORO_EXECUTE_SLF_XS (slf_init_pool_handler);
3267		3953
3268	void	3954	void
…		…
3279	for (i = 1; i < items; ++i)	3965	for (i = 1; i < items; ++i)
3280	av_push (av, SvREFCNT_inc_NN (ST (i)));	3966	av_push (av, SvREFCNT_inc_NN (ST (i)));
3281		3967
3282	if ((SV *)hv == &PL_sv_undef)	3968	if ((SV *)hv == &PL_sv_undef)
3283	{	3969	{
3284	PUSHMARK (SP);	3970	SV *sv = coro_new (aTHX_ coro_stash, (SV **)&cv_pool_handler, 1, 1);
3285	EXTEND (SP, 2);
3286	PUSHs (sv_Coro);
3287	PUSHs ((SV *)cv_pool_handler);
3288	PUTBACK;
3289	call_sv ((SV *)cv_coro_state_new, G_SCALAR);
3290	SPAGAIN;
3291
3292	hv = (HV *)SvREFCNT_inc_NN (SvRV (POPs));	3971	hv = (HV *)SvREFCNT_inc_NN (SvRV (sv));
		3972	SvREFCNT_dec (sv);
3293	}	3973	}
3294		3974
3295	{	3975	{
3296	struct coro *coro = SvSTATE_hv (hv);	3976	struct coro *coro = SvSTATE_hv (hv);
3297		3977
…		…
3321	rouse_wait (...)	4001	rouse_wait (...)
3322	PROTOTYPE: ;$	4002	PROTOTYPE: ;$
3323	PPCODE:	4003	PPCODE:
3324	CORO_EXECUTE_SLF_XS (slf_init_rouse_wait);	4004	CORO_EXECUTE_SLF_XS (slf_init_rouse_wait);
3325		4005
		4006	void
		4007	on_enter (SV *block)
		4008	ALIAS:
		4009	on_leave = 1
		4010	PROTOTYPE: &
		4011	CODE:
		4012	{
		4013	struct coro *coro = SvSTATE_current;
		4014	AV **avp = ix ? &coro->on_leave : &coro->on_enter;
		4015
		4016	block = s_get_cv_croak (block);
		4017
		4018	if (!*avp)
		4019	*avp = newAV ();
		4020
		4021	av_push (*avp, SvREFCNT_inc (block));
		4022
		4023	if (!ix)
		4024	on_enterleave_call (aTHX_ block);
		4025
		4026	LEAVE; /* pp_entersub unfortunately forces an ENTER/LEAVE around XS calls */
		4027	SAVEDESTRUCTOR_X (ix ? coro_pop_on_leave : coro_pop_on_enter, (void *)coro);
		4028	ENTER; /* pp_entersub unfortunately forces an ENTER/LEAVE around XS calls */
		4029	}
		4030
3326		4031
3327	MODULE = Coro::State PACKAGE = PerlIO::cede	4032	MODULE = Coro::State PACKAGE = PerlIO::cede
3328		4033
3329	BOOT:	4034	BOOT:
3330	PerlIO_define_layer (aTHX_ &PerlIO_cede);	4035	PerlIO_define_layer (aTHX_ &PerlIO_cede);
…		…
3333	MODULE = Coro::State PACKAGE = Coro::Semaphore	4038	MODULE = Coro::State PACKAGE = Coro::Semaphore
3334		4039
3335	SV *	4040	SV *
3336	new (SV *klass, SV *count = 0)	4041	new (SV *klass, SV *count = 0)
3337	CODE:	4042	CODE:
		4043	{
		4044	int semcnt = 1;
		4045
		4046	if (count)
		4047	{
		4048	SvGETMAGIC (count);
		4049
		4050	if (SvOK (count))
		4051	semcnt = SvIV (count);
		4052	}
		4053
3338	RETVAL = sv_bless (	4054	RETVAL = sv_bless (
3339	coro_waitarray_new (aTHX_ count && SvOK (count) ? SvIV (count) : 1),	4055	coro_waitarray_new (aTHX_ semcnt),
3340	GvSTASH (CvGV (cv))	4056	GvSTASH (CvGV (cv))
3341	);	4057	);
		4058	}
3342	OUTPUT:	4059	OUTPUT:
3343	RETVAL	4060	RETVAL
3344		4061
3345	# helper for Coro::Channel	4062	# helper for Coro::Channel and others
3346	SV *	4063	SV *
3347	_alloc (int count)	4064	_alloc (int count)
3348	CODE:	4065	CODE:
3349	RETVAL = coro_waitarray_new (aTHX_ count);	4066	RETVAL = coro_waitarray_new (aTHX_ count);
3350	OUTPUT:	4067	OUTPUT:
…		…
3392	XSRETURN_NO;	4109	XSRETURN_NO;
3393	}	4110	}
3394		4111
3395	void	4112	void
3396	waiters (SV *self)	4113	waiters (SV *self)
3397	PPCODE:	4114	PPCODE:
3398	{	4115	{
3399	AV *av = (AV *)SvRV (self);	4116	AV *av = (AV *)SvRV (self);
3400	int wcount = AvFILLp (av) + 1 - 1;	4117	int wcount = AvFILLp (av) + 1 - 1;
3401		4118
3402	if (GIMME_V == G_SCALAR)	4119	if (GIMME_V == G_SCALAR)
…		…
3408	for (i = 1; i <= wcount; ++i)	4125	for (i = 1; i <= wcount; ++i)
3409	PUSHs (sv_2mortal (newRV_inc (AvARRAY (av)[i])));	4126	PUSHs (sv_2mortal (newRV_inc (AvARRAY (av)[i])));
3410	}	4127	}
3411	}	4128	}
3412		4129
		4130	MODULE = Coro::State PACKAGE = Coro::SemaphoreSet
		4131
		4132	void
		4133	_may_delete (SV *sem, int count, unsigned int extra_refs)
		4134	PPCODE:
		4135	{
		4136	AV *av = (AV *)SvRV (sem);
		4137
		4138	if (SvREFCNT ((SV *)av) == 1 + extra_refs
		4139	&& AvFILLp (av) == 0 /* no waiters, just count */
		4140	&& SvIV (AvARRAY (av)[0]) == count)
		4141	XSRETURN_YES;
		4142
		4143	XSRETURN_NO;
		4144	}
		4145
3413	MODULE = Coro::State PACKAGE = Coro::Signal	4146	MODULE = Coro::State PACKAGE = Coro::Signal
3414		4147
3415	SV *	4148	SV *
3416	new (SV *klass)	4149	new (SV *klass)
3417	CODE:	4150	CODE:
…		…
3429		4162
3430	void	4163	void
3431	broadcast (SV *self)	4164	broadcast (SV *self)
3432	CODE:	4165	CODE:
3433	{	4166	{
3434	AV *av = (AV *)SvRV (self);	4167	AV *av = (AV *)SvRV (self);
3435	coro_signal_wake (aTHX_ av, AvFILLp (av));	4168	coro_signal_wake (aTHX_ av, AvFILLp (av));
3436	}	4169	}
3437		4170
3438	void	4171	void
3439	send (SV *self)	4172	send (SV *self)
…		…
3447	SvIVX (AvARRAY (av)[0]) = 1; /* remember the signal */	4180	SvIVX (AvARRAY (av)[0]) = 1; /* remember the signal */
3448	}	4181	}
3449		4182
3450	IV	4183	IV
3451	awaited (SV *self)	4184	awaited (SV *self)
3452	CODE:	4185	CODE:
3453	RETVAL = AvFILLp ((AV *)SvRV (self)) + 1 - 1;	4186	RETVAL = AvFILLp ((AV *)SvRV (self)) + 1 - 1;
3454	OUTPUT:	4187	OUTPUT:
3455	RETVAL	4188	RETVAL
3456		4189
3457		4190
…		…
3462		4195
3463	void	4196	void
3464	_schedule (...)	4197	_schedule (...)
3465	CODE:	4198	CODE:
3466	{	4199	{
3467	static int incede;	4200	static int incede;
3468		4201
3469	api_cede_notself (aTHX);	4202	api_cede_notself (aTHX);
3470		4203
3471	++incede;	4204	++incede;
3472	while (coro_nready >= incede && api_cede (aTHX))	4205	while (coro_nready >= incede && api_cede (aTHX))
…		…
3488		4221
3489	void	4222	void
3490	_register (char *target, char *proto, SV *req)	4223	_register (char *target, char *proto, SV *req)
3491	CODE:	4224	CODE:
3492	{	4225	{
3493	CV *req_cv = coro_sv_2cv (aTHX_ req);	4226	SV *req_cv = s_get_cv_croak (req);
3494	/* newXSproto doesn't return the CV on 5.8 */	4227	/* newXSproto doesn't return the CV on 5.8 */
3495	CV *slf_cv = newXS (target, coro_aio_req_xs, __FILE__);	4228	CV *slf_cv = newXS (target, coro_aio_req_xs, __FILE__);
3496	sv_setpv ((SV *)slf_cv, proto);	4229	sv_setpv ((SV *)slf_cv, proto);
3497	sv_magicext ((SV *)slf_cv, (SV *)req_cv, CORO_MAGIC_type_aio, 0, 0, 0);	4230	sv_magicext ((SV *)slf_cv, (SV *)req_cv, CORO_MAGIC_type_aio, 0, 0, 0);
3498	}	4231	}
3499		4232
		4233	MODULE = Coro::State PACKAGE = Coro::Select
		4234
		4235	void
		4236	patch_pp_sselect ()
		4237	CODE:
		4238	if (!coro_old_pp_sselect)
		4239	{
		4240	coro_select_select = (SV *)get_cv ("Coro::Select::select", 0);
		4241	coro_old_pp_sselect = PL_ppaddr [OP_SSELECT];
		4242	PL_ppaddr [OP_SSELECT] = coro_pp_sselect;
		4243	}
		4244
		4245	void
		4246	unpatch_pp_sselect ()
		4247	CODE:
		4248	if (coro_old_pp_sselect)
		4249	{
		4250	PL_ppaddr [OP_SSELECT] = coro_old_pp_sselect;
		4251	coro_old_pp_sselect = 0;
		4252	}
		4253
		4254	MODULE = Coro::State PACKAGE = Coro::Util
		4255
		4256	void
		4257	_exit (int code)
		4258	CODE:
		4259	_exit (code);
		4260
		4261	NV
		4262	time ()
		4263	CODE:
		4264	RETVAL = nvtime (aTHX);
		4265	OUTPUT:
		4266	RETVAL
		4267
		4268	NV
		4269	gettimeofday ()
		4270	PPCODE:
		4271	{
		4272	UV tv [2];
		4273	u2time (aTHX_ tv);
		4274	EXTEND (SP, 2);
		4275	PUSHs (sv_2mortal (newSVuv (tv [0])));
		4276	PUSHs (sv_2mortal (newSVuv (tv [1])));
		4277	}
		4278

Diff Legend

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