ViewVC Help

View File | Revision Log | Show Annotations | Download File

/cvs/Coro/Coro/State.xs

Comparing Coro/Coro/State.xs (file contents):
Revision 1.337 by root, Fri Dec 5 18:26:10 2008 UTC vs.
Revision 1.433 by root, Thu May 9 05:40:14 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
		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 const off = PadlistMAX (padlist) + 1;
417		517
418	newpadlist = newAV ();	518	newPADLIST(newpadlist);
		519	#if !PERL_VERSION_ATLEAST(5,15,3)
		520	/* Padlists are AvREAL as of 5.15.3. See perl bug #98092 and perl commit 7d953ba. */
419	AvREAL_off (newpadlist);	521	AvREAL_off (newpadlist);
		522	#endif
420	#if PERL_VERSION_ATLEAST (5,10,0)	523	#if PERL_VERSION_ATLEAST (5,10,0)
421	Perl_pad_push (aTHX_ padlist, AvFILLp (padlist) + 1);	524	Perl_pad_push (aTHX_ padlist, off);
422	#else	525	#else
423	Perl_pad_push (aTHX_ padlist, AvFILLp (padlist) + 1, 1);	526	Perl_pad_push (aTHX_ padlist, off, 1);
424	#endif	527	#endif
425	newpad = (AV *)AvARRAY (padlist)[AvFILLp (padlist)];	528	newpad = PadlistARRAY (padlist)[off];
426	--AvFILLp (padlist);	529	PadlistMAX (padlist) = off - 1;
427		530
428	av_store (newpadlist, 0, SvREFCNT_inc_NN (AvARRAY (padlist)[0]));	531	/* Already extended to 2 elements by newPADLIST. */
429	av_store (newpadlist, 1, (SV *)newpad);	532	PadlistMAX (newpadlist) = 1;
		533	PadlistNAMES (newpadlist) = (PADNAMELIST *)SvREFCNT_inc_NN (PadlistNAMES (padlist));
		534	PadlistARRAY (newpadlist)[1] = newpad;
430		535
431	return newpadlist;	536	return newpadlist;
432	}	537	}
433		538
434	static void	539	ecb_inline void
435	free_padlist (pTHX_ AV *padlist)	540	free_padlist (pTHX_ PADLIST *padlist)
436	{	541	{
437	/* may be during global destruction */	542	/* may be during global destruction */
438	if (!IN_DESTRUCT)	543	if (!IN_DESTRUCT)
439	{	544	{
440	I32 i = AvFILLp (padlist);	545	I32 i = PadlistMAX (padlist);
441		546
442	while (i > 0) /* special-case index 0 */	547	while (i > 0) /* special-case index 0 */
443	{	548	{
444	/* we try to be extra-careful here */	549	/* we try to be extra-careful here */
445	AV *av = (AV *)AvARRAY (padlist)[i--];	550	PAD *pad = PadlistARRAY (padlist)[i--];
446	I32 j = AvFILLp (av);	551	I32 j = PadMAX (pad);
447		552
448	while (j >= 0)	553	while (j >= 0)
449	SvREFCNT_dec (AvARRAY (av)[j--]);	554	SvREFCNT_dec (PadARRAY (pad)[j--]);
450		555
451	AvFILLp (av) = -1;	556	PadMAX (pad) = -1;
452	SvREFCNT_dec (av);	557	SvREFCNT_dec (pad);
453	}	558	}
454		559
455	SvREFCNT_dec (AvARRAY (padlist)[0]);	560	SvREFCNT_dec (PadlistNAMES (padlist));
456		561
		562	#ifdef NEWPADAPI
		563	Safefree (PadlistARRAY (padlist));
		564	Safefree (padlist);
		565	#else
457	AvFILLp (padlist) = -1;	566	AvFILLp (padlist) = -1;
		567	AvREAL_off (padlist);
458	SvREFCNT_dec ((SV*)padlist);	568	SvREFCNT_dec ((SV*)padlist);
		569	#endif
459	}	570	}
460	}	571	}
461		572
462	static int	573	static int
463	coro_cv_free (pTHX_ SV *sv, MAGIC *mg)	574	coro_cv_free (pTHX_ SV *sv, MAGIC *mg)
464	{	575	{
465	AV *padlist;	576	PADLIST *padlist;
466	AV *av = (AV *)mg->mg_obj;	577	PADLIST **padlists = (PADLIST **)(mg->mg_ptr + sizeof(size_t));
		578	size_t len = *(size_t *)mg->mg_ptr;
467		579
468	/* casting is fun. */	580	/* perl manages to free our internal AV and _then_ call us */
469	while (&PL_sv_undef != (SV *)(padlist = (AV *)av_pop (av)))	581	if (IN_DESTRUCT)
		582	return 0;
		583
		584	while (len--)
470	free_padlist (aTHX_ padlist);	585	free_padlist (aTHX_ padlists[len]);
471
472	SvREFCNT_dec (av); /* sv_magicext increased the refcount */
473		586
474	return 0;	587	return 0;
475	}	588	}
476		589
477	static MGVTBL coro_cv_vtbl = {	590	static MGVTBL coro_cv_vtbl = {
478	0, 0, 0, 0,	591	0, 0, 0, 0,
479	coro_cv_free	592	coro_cv_free
480	};	593	};
481		594
482	/* the next two functions merely cache the padlists */	595	/* the next two functions merely cache the padlists */
483	static void	596	ecb_inline void
484	get_padlist (pTHX_ CV *cv)	597	get_padlist (pTHX_ CV *cv)
485	{	598	{
486	MAGIC *mg = CORO_MAGIC_cv (cv);	599	MAGIC *mg = CORO_MAGIC_cv (cv);
487	AV *av;	600	size_t *lenp;
488		601
489	if (expect_true (mg && AvFILLp ((av = (AV *)mg->mg_obj)) >= 0))	602	if (ecb_expect_true (mg && *(lenp = (size_t *)mg->mg_ptr)))
490	CvPADLIST (cv) = (AV *)AvARRAY (av)[AvFILLp (av)--];	603	CvPADLIST (cv) = ((PADLIST **)(mg->mg_ptr + sizeof(size_t)))[--*lenp];
491	else	604	else
492	{	605	{
493	#if CORO_PREFER_PERL_FUNCTIONS	606	#if CORO_PREFER_PERL_FUNCTIONS
494	/* this is probably cleaner? but also slower! */	607	/* this is probably cleaner? but also slower! */
495	/* in practise, it seems to be less stable */	608	/* in practise, it seems to be less stable */
…		…
501	CvPADLIST (cv) = coro_derive_padlist (aTHX_ cv);	614	CvPADLIST (cv) = coro_derive_padlist (aTHX_ cv);
502	#endif	615	#endif
503	}	616	}
504	}	617	}
505		618
506	static void	619	ecb_inline void
507	put_padlist (pTHX_ CV *cv)	620	put_padlist (pTHX_ CV *cv)
508	{	621	{
509	MAGIC *mg = CORO_MAGIC_cv (cv);	622	MAGIC *mg = CORO_MAGIC_cv (cv);
510	AV *av;
511		623
512	if (expect_false (!mg))	624	if (ecb_expect_false (!mg))
		625	{
513	mg = sv_magicext ((SV *)cv, (SV *)newAV (), CORO_MAGIC_type_cv, &coro_cv_vtbl, 0, 0);	626	mg = sv_magicext ((SV *)cv, 0, CORO_MAGIC_type_cv, &coro_cv_vtbl, 0, 0);
		627	Newz (0, mg->mg_ptr ,sizeof (size_t) + sizeof (PADLIST *), char);
		628	mg->mg_len = 1; /* so mg_free frees mg_ptr */
		629	}
		630	else
		631	Renew (mg->mg_ptr,
		632	sizeof(size_t) + (*(size_t *)mg->mg_ptr + 1) * sizeof(PADLIST *),
		633	char);
514		634
515	av = (AV *)mg->mg_obj;	635	((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	}	636	}
522		637
523	/** load & save, init *******************************************************/	638	/** load & save, init *******************************************************/
		639
		640	ecb_inline void
		641	swap_sv (SV *a, SV *b)
		642	{
		643	const U32 keep = SVs_PADSTALE | SVs_PADTMP | SVs_PADMY; /* keep these flags */
		644	SV tmp;
		645
		646	/* swap sv_any */
		647	SvANY (&tmp) = SvANY (a); SvANY (a) = SvANY (b); SvANY (b) = SvANY (&tmp);
		648
		649	/* swap sv_flags */
		650	SvFLAGS (&tmp) = SvFLAGS (a);
		651	SvFLAGS (a) = (SvFLAGS (a) & keep) | (SvFLAGS (b ) & ~keep);
		652	SvFLAGS (b) = (SvFLAGS (b) & keep) | (SvFLAGS (&tmp) & ~keep);
		653
		654	#if PERL_VERSION_ATLEAST (5,10,0)
		655	/* perl 5.10 and later complicates this _quite_ a bit, but it also
		656	* is much faster, so no quarrels here. alternatively, we could
		657	* sv_upgrade to avoid this.
		658	*/
		659	{
		660	/* swap sv_u */
		661	tmp.sv_u = a->sv_u; a->sv_u = b->sv_u; b->sv_u = tmp.sv_u;
		662
		663	/* if SvANY points to the head, we need to adjust the pointers,
		664	* as the pointer for a still points to b, and maybe vice versa.
		665	*/
		666	#define svany_in_head(type) \
		667	(((1 << SVt_NULL) | (1 << SVt_BIND) | (1 << SVt_IV) | (1 << SVt_RV)) & (1 << (type)))
		668
		669	if (svany_in_head (SvTYPE (a)))
		670	SvANY (a) = (void *)((PTRV)SvANY (a) - (PTRV)b + (PTRV)a);
		671
		672	if (svany_in_head (SvTYPE (b)))
		673	SvANY (b) = (void *)((PTRV)SvANY (b) - (PTRV)a + (PTRV)b);
		674	}
		675	#endif
		676	}
		677
		678	/* swap sv heads, at least logically */
		679	static void
		680	swap_svs (pTHX_ Coro__State c)
		681	{
		682	int i;
		683
		684	for (i = 0; i <= AvFILLp (c->swap_sv); i += 2)
		685	swap_sv (AvARRAY (c->swap_sv)[i], AvARRAY (c->swap_sv)[i + 1]);
		686	}
		687
		688	#define SWAP_SVS(coro) \
		689	if (ecb_expect_false ((coro)->swap_sv)) \
		690	swap_svs (aTHX_ (coro))
		691
		692	static void
		693	on_enterleave_call (pTHX_ SV *cb);
524		694
525	static void	695	static void
526	load_perl (pTHX_ Coro__State c)	696	load_perl (pTHX_ Coro__State c)
527	{	697	{
528	perl_slots *slot = c->slot;	698	perl_slots *slot = c->slot;
529	c->slot = 0;	699	c->slot = 0;
530		700
531	PL_mainstack = c->mainstack;	701	PL_mainstack = c->mainstack;
532		702
533	GvSV (PL_defgv) = slot->defsv;	703	#if CORO_JIT
534	GvAV (PL_defgv) = slot->defav;	704	load_perl_slots (slot);
535	GvSV (PL_errgv) = slot->errsv;	705	#else
536	GvSV (irsgv) = slot->irsgv;
537	GvHV (PL_hintgv) = slot->hinthv;
538
539	#define VAR(name,type) PL_ ## name = slot->name;	706	#define VARx(name,expr,type) expr = slot->name;
540	# include "state.h"	707	#include "state.h"
541	#undef VAR	708	#endif
542		709
543	{	710	{
544	dSP;	711	dSP;
545		712
546	CV *cv;	713	CV *cv;
547		714
548	/* now do the ugly restore mess */	715	/* now do the ugly restore mess */
549	while (expect_true (cv = (CV *)POPs))	716	while (ecb_expect_true (cv = (CV *)POPs))
550	{	717	{
551	put_padlist (aTHX_ cv); /* mark this padlist as available */	718	put_padlist (aTHX_ cv); /* mark this padlist as available */
552	CvDEPTH (cv) = PTR2IV (POPs);	719	CvDEPTH (cv) = PTR2IV (POPs);
553	CvPADLIST (cv) = (AV *)POPs;	720	CvPADLIST (cv) = (PADLIST *)POPs;
554	}	721	}
555		722
556	PUTBACK;	723	PUTBACK;
557	}	724	}
558		725
559	slf_frame = c->slf_frame;	726	slf_frame = c->slf_frame;
560	CORO_THROW = c->except;	727	CORO_THROW = c->except;
		728
		729	if (ecb_expect_false (enable_times))
		730	{
		731	if (ecb_expect_false (!times_valid))
		732	coro_times_update ();
		733
		734	coro_times_sub (c);
		735	}
		736
		737	if (ecb_expect_false (c->on_enter))
		738	{
		739	int i;
		740
		741	for (i = 0; i <= AvFILLp (c->on_enter); ++i)
		742	on_enterleave_call (aTHX_ AvARRAY (c->on_enter)[i]);
		743	}
		744
		745	SWAP_SVS (c);
561	}	746	}
562		747
563	static void	748	static void
564	save_perl (pTHX_ Coro__State c)	749	save_perl (pTHX_ Coro__State c)
565	{	750	{
		751	SWAP_SVS (c);
		752
		753	if (ecb_expect_false (c->on_leave))
		754	{
		755	int i;
		756
		757	for (i = AvFILLp (c->on_leave); i >= 0; --i)
		758	on_enterleave_call (aTHX_ AvARRAY (c->on_leave)[i]);
		759	}
		760
		761	times_valid = 0;
		762
		763	if (ecb_expect_false (enable_times))
		764	{
		765	coro_times_update (); times_valid = 1;
		766	coro_times_add (c);
		767	}
		768
566	c->except = CORO_THROW;	769	c->except = CORO_THROW;
567	c->slf_frame = slf_frame;	770	c->slf_frame = slf_frame;
568		771
569	{	772	{
570	dSP;	773	dSP;
…		…
579		782
580	XPUSHs (Nullsv);	783	XPUSHs (Nullsv);
581	/* this loop was inspired by pp_caller */	784	/* this loop was inspired by pp_caller */
582	for (;;)	785	for (;;)
583	{	786	{
584	while (expect_true (cxix >= 0))	787	while (ecb_expect_true (cxix >= 0))
585	{	788	{
586	PERL_CONTEXT *cx = &ccstk[cxix--];	789	PERL_CONTEXT *cx = &ccstk[cxix--];
587		790
588	if (expect_true (CxTYPE (cx) == CXt_SUB || CxTYPE (cx) == CXt_FORMAT))	791	if (ecb_expect_true (CxTYPE (cx) == CXt_SUB) || ecb_expect_false (CxTYPE (cx) == CXt_FORMAT))
589	{	792	{
590	CV *cv = cx->blk_sub.cv;	793	CV *cv = cx->blk_sub.cv;
591		794
592	if (expect_true (CvDEPTH (cv)))	795	if (ecb_expect_true (CvDEPTH (cv)))
593	{	796	{
594	EXTEND (SP, 3);	797	EXTEND (SP, 3);
595	PUSHs ((SV *)CvPADLIST (cv));	798	PUSHs ((SV *)CvPADLIST (cv));
596	PUSHs (INT2PTR (SV *, (IV)CvDEPTH (cv)));	799	PUSHs (INT2PTR (SV *, (IV)CvDEPTH (cv)));
597	PUSHs ((SV *)cv);	800	PUSHs ((SV *)cv);
…		…
600	get_padlist (aTHX_ cv);	803	get_padlist (aTHX_ cv);
601	}	804	}
602	}	805	}
603	}	806	}
604		807
605	if (expect_true (top_si->si_type == PERLSI_MAIN))	808	if (ecb_expect_true (top_si->si_type == PERLSI_MAIN))
606	break;	809	break;
607		810
608	top_si = top_si->si_prev;	811	top_si = top_si->si_prev;
609	ccstk = top_si->si_cxstack;	812	ccstk = top_si->si_cxstack;
610	cxix = top_si->si_cxix;	813	cxix = top_si->si_cxix;
…		…
612		815
613	PUTBACK;	816	PUTBACK;
614	}	817	}
615		818
616	/* allocate some space on the context stack for our purposes */	819	/* allocate some space on the context stack for our purposes */
617	/* we manually unroll here, as usually 2 slots is enough */	820	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	{	821	{
622	int i;	822	unsigned int i;
		823
623	for (i = 3; i < SLOT_COUNT; ++i)	824	for (i = 0; i < SLOT_COUNT; ++i)
624	CXINC;	825	CXINC;
625	}	826
626	cxstack_ix -= SLOT_COUNT; /* undo allocation */	827	cxstack_ix -= SLOT_COUNT; /* undo allocation */
		828	}
627		829
628	c->mainstack = PL_mainstack;	830	c->mainstack = PL_mainstack;
629		831
630	{	832	{
631	perl_slots *slot = c->slot = (perl_slots *)(cxstack + cxstack_ix + 1);	833	perl_slots *slot = c->slot = (perl_slots *)(cxstack + cxstack_ix + 1);
632		834
633	slot->defav = GvAV (PL_defgv);	835	#if CORO_JIT
634	slot->defsv = DEFSV;	836	save_perl_slots (slot);
635	slot->errsv = ERRSV;	837	#else
636	slot->irsgv = GvSV (irsgv);
637	slot->hinthv = GvHV (PL_hintgv);
638
639	#define VAR(name,type) slot->name = PL_ ## name;	838	#define VARx(name,expr,type) slot->name = expr;
640	# include "state.h"	839	#include "state.h"
641	#undef VAR	840	#endif
642	}	841	}
643	}	842	}
644		843
645	/*	844	/*
646	* allocate various perl stacks. This is almost an exact copy	845	* allocate various perl stacks. This is almost an exact copy
…		…
652	# define coro_init_stacks(thx) init_stacks ()	851	# define coro_init_stacks(thx) init_stacks ()
653	#else	852	#else
654	static void	853	static void
655	coro_init_stacks (pTHX)	854	coro_init_stacks (pTHX)
656	{	855	{
657	PL_curstackinfo = new_stackinfo(32, 8);	856	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;	857	PL_curstackinfo->si_type = PERLSI_MAIN;
659	PL_curstack = PL_curstackinfo->si_stack;	858	PL_curstack = PL_curstackinfo->si_stack;
660	PL_mainstack = PL_curstack; /* remember in case we switch stacks */	859	PL_mainstack = PL_curstack; /* remember in case we switch stacks */
661		860
662	PL_stack_base = AvARRAY(PL_curstack);	861	PL_stack_base = AvARRAY(PL_curstack);
…		…
677	#endif	876	#endif
678		877
679	New(54,PL_scopestack,8,I32);	878	New(54,PL_scopestack,8,I32);
680	PL_scopestack_ix = 0;	879	PL_scopestack_ix = 0;
681	PL_scopestack_max = 8;	880	PL_scopestack_max = 8;
		881	#if HAS_SCOPESTACK_NAME
		882	New(54,PL_scopestack_name,8,const char*);
		883	#endif
682		884
683	New(54,PL_savestack,24,ANY);	885	New(54,PL_savestack,24,ANY);
684	PL_savestack_ix = 0;	886	PL_savestack_ix = 0;
685	PL_savestack_max = 24;	887	PL_savestack_max = 24;
686		888
…		…
714	}	916	}
715		917
716	Safefree (PL_tmps_stack);	918	Safefree (PL_tmps_stack);
717	Safefree (PL_markstack);	919	Safefree (PL_markstack);
718	Safefree (PL_scopestack);	920	Safefree (PL_scopestack);
		921	#if HAS_SCOPESTACK_NAME
		922	Safefree (PL_scopestack_name);
		923	#endif
719	Safefree (PL_savestack);	924	Safefree (PL_savestack);
720	#if !PERL_VERSION_ATLEAST (5,10,0)	925	#if !PERL_VERSION_ATLEAST (5,10,0)
721	Safefree (PL_retstack);	926	Safefree (PL_retstack);
722	#endif	927	#endif
723	}	928	}
…		…
769	#endif	974	#endif
770		975
771	/*	976	/*
772	* This overrides the default magic get method of %SIG elements.	977	* 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	978	* 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	979	* and instead of trying to save and restore the hash elements (extremely slow),
775	* readback here.	980	* 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	*/	981	*/
780	static int	982	static int ecb_cold
781	coro_sigelem_get (pTHX_ SV *sv, MAGIC *mg)	983	coro_sigelem_get (pTHX_ SV *sv, MAGIC *mg)
782	{	984	{
783	const char *s = MgPV_nolen_const (mg);	985	const char *s = MgPV_nolen_const (mg);
784		986
785	if (*s == '_')	987	if (*s == '_')
786	{	988	{
787	SV **svp = 0;	989	SV **svp = 0;
788		990
789	if (strEQ (s, "__DIE__" )) svp = &PL_diehook;	991	if (strEQ (s, "__DIE__" )) svp = &PL_diehook;
790	if (strEQ (s, "__WARN__")) svp = &PL_warnhook;	992	if (strEQ (s, "__WARN__")) svp = &PL_warnhook;
791		993
792	if (svp)	994	if (svp)
793	{	995	{
794	sv_setsv (sv, *svp ? *svp : &PL_sv_undef);	996	SV *ssv;
		997
		998	if (!*svp)
		999	ssv = &PL_sv_undef;
		1000	else if (SvTYPE (*svp) == SVt_PVCV) /* perlio directly stores a CV in warnhook. ugh. */
		1001	ssv = sv_2mortal (newRV_inc (*svp));
		1002	else
		1003	ssv = *svp;
		1004
		1005	sv_setsv (sv, ssv);
795	return 0;	1006	return 0;
796	}	1007	}
797	}	1008	}
798		1009
799	return orig_sigelem_get ? orig_sigelem_get (aTHX_ sv, mg) : 0;	1010	return orig_sigelem_get ? orig_sigelem_get (aTHX_ sv, mg) : 0;
800	}	1011	}
801		1012
802	static int	1013	static int ecb_cold
803	coro_sigelem_clr (pTHX_ SV *sv, MAGIC *mg)	1014	coro_sigelem_clr (pTHX_ SV *sv, MAGIC *mg)
804	{	1015	{
805	const char *s = MgPV_nolen_const (mg);	1016	const char *s = MgPV_nolen_const (mg);
806		1017
807	if (*s == '_')	1018	if (*s == '_')
…		…
821	}	1032	}
822		1033
823	return orig_sigelem_clr ? orig_sigelem_clr (aTHX_ sv, mg) : 0;	1034	return orig_sigelem_clr ? orig_sigelem_clr (aTHX_ sv, mg) : 0;
824	}	1035	}
825		1036
826	static int	1037	static int ecb_cold
827	coro_sigelem_set (pTHX_ SV *sv, MAGIC *mg)	1038	coro_sigelem_set (pTHX_ SV *sv, MAGIC *mg)
828	{	1039	{
829	const char *s = MgPV_nolen_const (mg);	1040	const char *s = MgPV_nolen_const (mg);
830		1041
831	if (*s == '_')	1042	if (*s == '_')
…		…
836	if (strEQ (s, "__WARN__")) svp = &PL_warnhook;	1047	if (strEQ (s, "__WARN__")) svp = &PL_warnhook;
837		1048
838	if (svp)	1049	if (svp)
839	{	1050	{
840	SV *old = *svp;	1051	SV *old = *svp;
841	*svp = newSVsv (sv);	1052	*svp = SvOK (sv) ? newSVsv (sv) : 0;
842	SvREFCNT_dec (old);	1053	SvREFCNT_dec (old);
843	return 0;	1054	return 0;
844	}	1055	}
845	}	1056	}
846		1057
…		…
864	slf_check_repeat (pTHX_ struct CoroSLF *frame)	1075	slf_check_repeat (pTHX_ struct CoroSLF *frame)
865	{	1076	{
866	return 1;	1077	return 1;
867	}	1078	}
868		1079
869	static UNOP coro_setup_op;	1080	static UNOP init_perl_op;
870		1081
871	static void NOINLINE /* noinline to keep it out of the transfer fast path */	1082	ecb_noinline static void /* noinline to keep it out of the transfer fast path */
872	coro_setup (pTHX_ struct coro *coro)	1083	init_perl (pTHX_ struct coro *coro)
873	{	1084	{
874	/*	1085	/*
875	* emulate part of the perl startup here.	1086	* emulate part of the perl startup here.
876	*/	1087	*/
877	coro_init_stacks (aTHX);	1088	coro_init_stacks (aTHX);
…		…
884	PL_comppad_name_fill = 0;	1095	PL_comppad_name_fill = 0;
885	PL_comppad_name_floor = 0;	1096	PL_comppad_name_floor = 0;
886	PL_curpm = 0;	1097	PL_curpm = 0;
887	PL_curpad = 0;	1098	PL_curpad = 0;
888	PL_localizing = 0;	1099	PL_localizing = 0;
889	PL_dirty = 0;
890	PL_restartop = 0;	1100	PL_restartop = 0;
891	#if PERL_VERSION_ATLEAST (5,10,0)	1101	#if PERL_VERSION_ATLEAST (5,10,0)
892	PL_parser = 0;	1102	PL_parser = 0;
893	#endif	1103	#endif
894	PL_hints = 0;	1104	PL_hints = 0;
895		1105
896	/* recreate the die/warn hooks */	1106	/* recreate the die/warn hooks */
897	PL_diehook = 0; SvSetMagicSV (*hv_fetch (hv_sig, "__DIE__" , sizeof ("__DIE__" ) - 1, 1), rv_diehook );	1107	PL_diehook = SvREFCNT_inc (rv_diehook);
898	PL_warnhook = 0; SvSetMagicSV (*hv_fetch (hv_sig, "__WARN__", sizeof ("__WARN__") - 1, 1), rv_warnhook);	1108	PL_warnhook = SvREFCNT_inc (rv_warnhook);
899		1109
900	GvSV (PL_defgv) = newSV (0);	1110	GvSV (PL_defgv) = newSV (0);
901	GvAV (PL_defgv) = coro->args; coro->args = 0;	1111	GvAV (PL_defgv) = coro->args; coro->args = 0;
902	GvSV (PL_errgv) = newSV (0);	1112	GvSV (PL_errgv) = newSV (0);
903	GvSV (irsgv) = newSVpvn ("\n", 1); sv_magic (GvSV (irsgv), (SV *)irsgv, PERL_MAGIC_sv, "/", 0);	1113	GvSV (irsgv) = newSVpvn ("\n", 1); sv_magic (GvSV (irsgv), (SV *)irsgv, PERL_MAGIC_sv, "/", 0);
904	GvHV (PL_hintgv) = 0;	1114	GvHV (PL_hintgv) = 0;
…		…
924	/* this newly created coroutine might be run on an existing cctx which most	1134	/* 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.	1135	* likely was suspended in pp_slf, so we have to emulate entering pp_slf here.
926	*/	1136	*/
927	slf_frame.prepare = prepare_nop; /* provide a nop function for an eventual pp_slf */	1137	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 */	1138	slf_frame.check = slf_check_nop; /* signal pp_slf to not repeat */
		1139	slf_frame.destroy = 0;
929		1140
930	/* and we have to provide the pp_slf op in any case, so pp_slf can skip it */	1141	/* 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;	1142	init_perl_op.op_next = PL_op;
932	coro_setup_op.op_type = OP_ENTERSUB;	1143	init_perl_op.op_type = OP_ENTERSUB;
933	coro_setup_op.op_ppaddr = pp_slf;	1144	init_perl_op.op_ppaddr = pp_slf;
934	/* no flags etc. required, as an init function won't be called */	1145	/* no flags etc. required, as an init function won't be called */
935		1146
936	PL_op = (OP *)&coro_setup_op;	1147	PL_op = (OP *)&init_perl_op;
937		1148
938	/* copy throw, in case it was set before coro_setup */	1149	/* copy throw, in case it was set before init_perl */
939	CORO_THROW = coro->except;	1150	CORO_THROW = coro->except;
		1151
		1152	SWAP_SVS (coro);
		1153
		1154	if (ecb_expect_false (enable_times))
		1155	{
		1156	coro_times_update ();
		1157	coro_times_sub (coro);
		1158	}
940	}	1159	}
941		1160
942	static void	1161	static void
943	coro_unwind_stacks (pTHX)	1162	coro_unwind_stacks (pTHX)
944	{	1163	{
…		…
959	dounwind (-1);	1178	dounwind (-1);
960	}	1179	}
961	}	1180	}
962		1181
963	static void	1182	static void
964	coro_destruct_perl (pTHX_ struct coro *coro)	1183	destroy_perl (pTHX_ struct coro *coro)
965	{	1184	{
		1185	SV *svf [9];
		1186
		1187	{
		1188	SV *old_current = SvRV (coro_current);
		1189	struct coro *current = SvSTATE (old_current);
		1190
		1191	assert (("FATAL: tried to destroy currently running coroutine", coro->mainstack != PL_mainstack));
		1192
		1193	save_perl (aTHX_ current);
		1194
		1195	/* this will cause transfer_check to croak on block*/
		1196	SvRV_set (coro_current, (SV *)coro->hv);
		1197
		1198	load_perl (aTHX_ coro);
		1199
966	coro_unwind_stacks (aTHX);	1200	coro_unwind_stacks (aTHX);
967		1201
968	SvREFCNT_dec (GvSV (PL_defgv));	1202	/* restore swapped sv's */
969	SvREFCNT_dec (GvAV (PL_defgv));	1203	SWAP_SVS (coro);
970	SvREFCNT_dec (GvSV (PL_errgv));
971	SvREFCNT_dec (PL_defoutgv);
972	SvREFCNT_dec (PL_rs);
973	SvREFCNT_dec (GvSV (irsgv));
974	SvREFCNT_dec (GvHV (PL_hintgv));
975		1204
976	SvREFCNT_dec (PL_diehook);	1205	coro_destruct_stacks (aTHX);
977	SvREFCNT_dec (PL_warnhook);	1206
		1207	/* now save some sv's to be free'd later */
		1208	svf [0] = GvSV (PL_defgv);
		1209	svf [1] = (SV *)GvAV (PL_defgv);
		1210	svf [2] = GvSV (PL_errgv);
		1211	svf [3] = (SV *)PL_defoutgv;
		1212	svf [4] = PL_rs;
		1213	svf [5] = GvSV (irsgv);
		1214	svf [6] = (SV *)GvHV (PL_hintgv);
		1215	svf [7] = PL_diehook;
		1216	svf [8] = PL_warnhook;
		1217	assert (9 == sizeof (svf) / sizeof (*svf));
		1218
		1219	SvRV_set (coro_current, old_current);
		1220
		1221	load_perl (aTHX_ current);
978		1222	}
		1223
		1224	{
		1225	unsigned int i;
		1226
		1227	for (i = 0; i < sizeof (svf) / sizeof (*svf); ++i)
		1228	SvREFCNT_dec (svf [i]);
		1229
979	SvREFCNT_dec (coro->saved_deffh);	1230	SvREFCNT_dec (coro->saved_deffh);
980	SvREFCNT_dec (coro->rouse_cb);	1231	SvREFCNT_dec (coro->rouse_cb);
981	SvREFCNT_dec (coro->invoke_cb);	1232	SvREFCNT_dec (coro->invoke_cb);
982	SvREFCNT_dec (coro->invoke_av);	1233	SvREFCNT_dec (coro->invoke_av);
983		1234	}
984	coro_destruct_stacks (aTHX);
985	}	1235	}
986		1236
987	INLINE void	1237	ecb_inline void
988	free_coro_mortal (pTHX)	1238	free_coro_mortal (pTHX)
989	{	1239	{
990	if (expect_true (coro_mortal))	1240	if (ecb_expect_true (coro_mortal))
991	{	1241	{
992	SvREFCNT_dec (coro_mortal);	1242	SvREFCNT_dec ((SV *)coro_mortal);
993	coro_mortal = 0;	1243	coro_mortal = 0;
994	}	1244	}
995	}	1245	}
996		1246
997	static int	1247	static int
…		…
1130		1380
1131	return frame->check (aTHX_ frame); /* execute the restored frame - there must be one */	1381	return frame->check (aTHX_ frame); /* execute the restored frame - there must be one */
1132	}	1382	}
1133		1383
1134	/* initialises PL_top_env and injects a pseudo-slf-call to set the stacklevel */	1384	/* initialises PL_top_env and injects a pseudo-slf-call to set the stacklevel */
1135	static void NOINLINE	1385	static void ecb_noinline
1136	cctx_prepare (pTHX)	1386	cctx_prepare (pTHX)
1137	{	1387	{
1138	PL_top_env = &PL_start_env;	1388	PL_top_env = &PL_start_env;
1139		1389
1140	if (cctx_current->flags & CC_TRACE)	1390	if (cctx_current->flags & CC_TRACE)
…		…
1151	slf_frame.prepare = slf_prepare_set_stacklevel;	1401	slf_frame.prepare = slf_prepare_set_stacklevel;
1152	slf_frame.check = slf_check_set_stacklevel;	1402	slf_frame.check = slf_check_set_stacklevel;
1153	}	1403	}
1154		1404
1155	/* the tail of transfer: execute stuff we can only do after a transfer */	1405	/* the tail of transfer: execute stuff we can only do after a transfer */
1156	INLINE void	1406	ecb_inline void
1157	transfer_tail (pTHX)	1407	transfer_tail (pTHX)
1158	{	1408	{
1159	free_coro_mortal (aTHX);	1409	free_coro_mortal (aTHX);
		1410	}
		1411
		1412	/* try to exit the same way perl's main function would do */
		1413	/* we do not bother resetting the environment or other things *7
		1414	/* that are not, uhm, essential */
		1415	/* this obviously also doesn't work when perl is embedded */
		1416	static void ecb_noinline ecb_cold
		1417	perlish_exit (pTHX)
		1418	{
		1419	int exitstatus = perl_destruct (PL_curinterp);
		1420	perl_free (PL_curinterp);
		1421	exit (exitstatus);
1160	}	1422	}
1161		1423
1162	/*	1424	/*
1163	* this is a _very_ stripped down perl interpreter ;)	1425	* this is a _very_ stripped down perl interpreter ;)
1164	*/	1426	*/
…		…
1186	/* somebody or something will hit me for both perl_run and PL_restartop */	1448	/* somebody or something will hit me for both perl_run and PL_restartop */
1187	PL_restartop = PL_op;	1449	PL_restartop = PL_op;
1188	perl_run (PL_curinterp);	1450	perl_run (PL_curinterp);
1189	/*	1451	/*
1190	* Unfortunately, there is no way to get at the return values of the	1452	* Unfortunately, there is no way to get at the return values of the
1191	* coro body here, as perl_run destroys these	1453	* coro body here, as perl_run destroys these. Likewise, we cannot catch
		1454	* runtime errors here, as this is just a random interpreter, not a thread.
1192	*/	1455	*/
1193		1456
1194	/*	1457	/*
1195	* If perl-run returns we assume exit() was being called or the coro	1458	* If perl-run returns we assume exit() was being called or the coro
1196	* fell off the end, which seems to be the only valid (non-bug)	1459	* fell off the end, which seems to be the only valid (non-bug)
1197	* reason for perl_run to return. We try to exit by jumping to the	1460	* reason for perl_run to return. We try to mimic whatever perl is normally
1198	* bootstrap-time "top" top_env, as we cannot restore the "main"	1461	* doing in that case. YMMV.
1199	* coroutine as Coro has no such concept.
1200	* This actually isn't valid with the pthread backend, but OSes requiring
1201	* that backend are too broken to do it in a standards-compliant way.
1202	*/	1462	*/
1203	PL_top_env = main_top_env;	1463	perlish_exit (aTHX);
1204	JMPENV_JUMP (2); /* I do not feel well about the hardcoded 2 at all */
1205	}	1464	}
1206	}	1465	}
1207		1466
1208	static coro_cctx *	1467	static coro_cctx *
1209	cctx_new ()	1468	cctx_new (void)
1210	{	1469	{
1211	coro_cctx *cctx;	1470	coro_cctx *cctx;
1212		1471
1213	++cctx_count;	1472	++cctx_count;
1214	New (0, cctx, 1, coro_cctx);	1473	New (0, cctx, 1, coro_cctx);
…		…
1220	return cctx;	1479	return cctx;
1221	}	1480	}
1222		1481
1223	/* create a new cctx only suitable as source */	1482	/* create a new cctx only suitable as source */
1224	static coro_cctx *	1483	static coro_cctx *
1225	cctx_new_empty ()	1484	cctx_new_empty (void)
1226	{	1485	{
1227	coro_cctx *cctx = cctx_new ();	1486	coro_cctx *cctx = cctx_new ();
1228		1487
1229	cctx->sptr = 0;	1488	cctx->stack.sptr = 0;
1230	coro_create (&cctx->cctx, 0, 0, 0, 0);	1489	coro_create (&cctx->cctx, 0, 0, 0, 0);
1231		1490
1232	return cctx;	1491	return cctx;
1233	}	1492	}
1234		1493
1235	/* create a new cctx suitable as destination/running a perl interpreter */	1494	/* create a new cctx suitable as destination/running a perl interpreter */
1236	static coro_cctx *	1495	static coro_cctx *
1237	cctx_new_run ()	1496	cctx_new_run (void)
1238	{	1497	{
1239	coro_cctx *cctx = cctx_new ();	1498	coro_cctx *cctx = cctx_new ();
1240	void *stack_start;
1241	size_t stack_size;
1242		1499
1243	#if HAVE_MMAP	1500	if (!coro_stack_alloc (&cctx->stack, cctx_stacksize))
1244	cctx->ssize = ((cctx_stacksize * sizeof (long) + PAGESIZE - 1) / PAGESIZE + CORO_STACKGUARD) * PAGESIZE;
1245	/* mmap supposedly does allocate-on-write for us */
1246	cctx->sptr = mmap (0, cctx->ssize, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_PRIVATE|MAP_ANONYMOUS, 0, 0);
1247
1248	if (cctx->sptr != (void *)-1)
1249	{
1250	#if CORO_STACKGUARD
1251	mprotect (cctx->sptr, CORO_STACKGUARD * PAGESIZE, PROT_NONE);
1252	#endif
1253	stack_start = (char *)cctx->sptr + CORO_STACKGUARD * PAGESIZE;
1254	stack_size = cctx->ssize - CORO_STACKGUARD * PAGESIZE;
1255	cctx->flags |= CC_MAPPED;
1256	}	1501	{
1257	else
1258	#endif
1259	{
1260	cctx->ssize = cctx_stacksize * (long)sizeof (long);
1261	New (0, cctx->sptr, cctx_stacksize, long);
1262
1263	if (!cctx->sptr)
1264	{
1265	perror ("FATAL: unable to allocate stack for coroutine, exiting.");	1502	perror ("FATAL: unable to allocate stack for coroutine, exiting.");
1266	_exit (EXIT_FAILURE);	1503	_exit (EXIT_FAILURE);
1267	}
1268
1269	stack_start = cctx->sptr;
1270	stack_size = cctx->ssize;
1271	}	1504	}
1272		1505
1273	#if CORO_USE_VALGRIND
1274	cctx->valgrind_id = VALGRIND_STACK_REGISTER ((char *)stack_start, (char *)stack_start + stack_size);
1275	#endif
1276
1277	coro_create (&cctx->cctx, cctx_run, (void *)cctx, stack_start, stack_size);	1506	coro_create (&cctx->cctx, cctx_run, (void *)cctx, cctx->stack.sptr, cctx->stack.ssze);
1278		1507
1279	return cctx;	1508	return cctx;
1280	}	1509	}
1281		1510
1282	static void	1511	static void
1283	cctx_destroy (coro_cctx *cctx)	1512	cctx_destroy (coro_cctx *cctx)
1284	{	1513	{
1285	if (!cctx)	1514	if (!cctx)
1286	return;	1515	return;
1287		1516
1288	assert (("FATAL: tried to destroy current cctx", cctx != cctx_current));//D temporary?	1517	assert (("FATAL: tried to destroy current cctx", cctx != cctx_current));
1289		1518
1290	--cctx_count;	1519	--cctx_count;
1291	coro_destroy (&cctx->cctx);	1520	coro_destroy (&cctx->cctx);
1292		1521
1293	/* coro_transfer creates new, empty cctx's */	1522	coro_stack_free (&cctx->stack);
1294	if (cctx->sptr)
1295	{
1296	#if CORO_USE_VALGRIND
1297	VALGRIND_STACK_DEREGISTER (cctx->valgrind_id);
1298	#endif
1299
1300	#if HAVE_MMAP
1301	if (cctx->flags & CC_MAPPED)
1302	munmap (cctx->sptr, cctx->ssize);
1303	else
1304	#endif
1305	Safefree (cctx->sptr);
1306	}
1307		1523
1308	Safefree (cctx);	1524	Safefree (cctx);
1309	}	1525	}
1310		1526
1311	/* wether this cctx should be destructed */	1527	/* wether this cctx should be destructed */
1312	#define CCTX_EXPIRED(cctx) ((cctx)->gen != cctx_gen || ((cctx)->flags & CC_NOREUSE))	1528	#define CCTX_EXPIRED(cctx) ((cctx)->gen != cctx_gen || ((cctx)->flags & CC_NOREUSE))
1313		1529
1314	static coro_cctx *	1530	static coro_cctx *
1315	cctx_get (pTHX)	1531	cctx_get (pTHX)
1316	{	1532	{
1317	while (expect_true (cctx_first))	1533	while (ecb_expect_true (cctx_first))
1318	{	1534	{
1319	coro_cctx *cctx = cctx_first;	1535	coro_cctx *cctx = cctx_first;
1320	cctx_first = cctx->next;	1536	cctx_first = cctx->next;
1321	--cctx_idle;	1537	--cctx_idle;
1322		1538
1323	if (expect_true (!CCTX_EXPIRED (cctx)))	1539	if (ecb_expect_true (!CCTX_EXPIRED (cctx)))
1324	return cctx;	1540	return cctx;
1325		1541
1326	cctx_destroy (cctx);	1542	cctx_destroy (cctx);
1327	}	1543	}
1328		1544
…		…
1330	}	1546	}
1331		1547
1332	static void	1548	static void
1333	cctx_put (coro_cctx *cctx)	1549	cctx_put (coro_cctx *cctx)
1334	{	1550	{
1335	assert (("FATAL: cctx_put called on non-initialised cctx in Coro (please report)", cctx->sptr));	1551	assert (("FATAL: cctx_put called on non-initialised cctx in Coro (please report)", cctx->stack.sptr));
1336		1552
1337	/* free another cctx if overlimit */	1553	/* free another cctx if overlimit */
1338	if (expect_false (cctx_idle >= cctx_max_idle))	1554	if (ecb_expect_false (cctx_idle >= cctx_max_idle))
1339	{	1555	{
1340	coro_cctx *first = cctx_first;	1556	coro_cctx *first = cctx_first;
1341	cctx_first = first->next;	1557	cctx_first = first->next;
1342	--cctx_idle;	1558	--cctx_idle;
1343		1559
…		…
1354	static void	1570	static void
1355	transfer_check (pTHX_ struct coro *prev, struct coro *next)	1571	transfer_check (pTHX_ struct coro *prev, struct coro *next)
1356	{	1572	{
1357	/* TODO: throwing up here is considered harmful */	1573	/* TODO: throwing up here is considered harmful */
1358		1574
1359	if (expect_true (prev != next))	1575	if (ecb_expect_true (prev != next))
1360	{	1576	{
1361	if (expect_false (!(prev->flags & (CF_RUNNING | CF_NEW))))	1577	if (ecb_expect_false (!(prev->flags & (CF_RUNNING | CF_NEW))))
1362	croak ("Coro::State::transfer called with a suspended prev Coro::State, but can only transfer from running or new states,");	1578	croak ("Coro::State::transfer called with a blocked prev Coro::State, but can only transfer from running or new states,");
1363		1579
1364	if (expect_false (next->flags & CF_RUNNING))	1580	if (ecb_expect_false (next->flags & (CF_RUNNING | CF_ZOMBIE | CF_SUSPENDED)))
1365	croak ("Coro::State::transfer called with running next Coro::State, but can only transfer to inactive states,");
1366
1367	if (expect_false (next->flags & CF_DESTROYED))
1368	croak ("Coro::State::transfer called with destroyed next Coro::State, but can only transfer to inactive states,");	1581	croak ("Coro::State::transfer called with running, destroyed or suspended next Coro::State, but can only transfer to inactive states,");
1369		1582
1370	#if !PERL_VERSION_ATLEAST (5,10,0)	1583	#if !PERL_VERSION_ATLEAST (5,10,0)
1371	if (expect_false (PL_lex_state != LEX_NOTPARSING))	1584	if (ecb_expect_false (PL_lex_state != LEX_NOTPARSING))
1372	croak ("Coro::State::transfer called while parsing, but this is not supported in your perl version,");	1585	croak ("Coro::State::transfer called while parsing, but this is not supported in your perl version,");
1373	#endif	1586	#endif
1374	}	1587	}
1375	}	1588	}
1376		1589
1377	/* always use the TRANSFER macro */	1590	/* always use the TRANSFER macro */
1378	static void NOINLINE /* noinline so we have a fixed stackframe */	1591	static void ecb_noinline /* noinline so we have a fixed stackframe */
1379	transfer (pTHX_ struct coro *prev, struct coro *next, int force_cctx)	1592	transfer (pTHX_ struct coro *prev, struct coro *next, int force_cctx)
1380	{	1593	{
1381	dSTACKLEVEL;	1594	dSTACKLEVEL;
1382		1595
1383	/* sometimes transfer is only called to set idle_sp */	1596	/* sometimes transfer is only called to set idle_sp */
1384	if (expect_false (!prev))	1597	if (ecb_expect_false (!prev))
1385	{	1598	{
1386	cctx_current->idle_sp = STACKLEVEL;	1599	cctx_current->idle_sp = STACKLEVEL;
1387	assert (cctx_current->idle_te = PL_top_env); /* just for the side-effect when asserts are enabled */	1600	assert (cctx_current->idle_te = PL_top_env); /* just for the side-effect when asserts are enabled */
1388	}	1601	}
1389	else if (expect_true (prev != next))	1602	else if (ecb_expect_true (prev != next))
1390	{	1603	{
1391	coro_cctx *cctx_prev;	1604	coro_cctx *cctx_prev;
1392		1605
1393	if (expect_false (prev->flags & CF_NEW))	1606	if (ecb_expect_false (prev->flags & CF_NEW))
1394	{	1607	{
1395	/* create a new empty/source context */	1608	/* create a new empty/source context */
1396	prev->flags &= ~CF_NEW;	1609	prev->flags &= ~CF_NEW;
1397	prev->flags |= CF_RUNNING;	1610	prev->flags |= CF_RUNNING;
1398	}	1611	}
…		…
1401	next->flags |= CF_RUNNING;	1614	next->flags |= CF_RUNNING;
1402		1615
1403	/* first get rid of the old state */	1616	/* first get rid of the old state */
1404	save_perl (aTHX_ prev);	1617	save_perl (aTHX_ prev);
1405		1618
1406	if (expect_false (next->flags & CF_NEW))	1619	if (ecb_expect_false (next->flags & CF_NEW))
1407	{	1620	{
1408	/* need to start coroutine */	1621	/* need to start coroutine */
1409	next->flags &= ~CF_NEW;	1622	next->flags &= ~CF_NEW;
1410	/* setup coroutine call */	1623	/* setup coroutine call */
1411	coro_setup (aTHX_ next);	1624	init_perl (aTHX_ next);
1412	}	1625	}
1413	else	1626	else
1414	load_perl (aTHX_ next);	1627	load_perl (aTHX_ next);
1415		1628
1416	/* possibly untie and reuse the cctx */	1629	/* possibly untie and reuse the cctx */
1417	if (expect_true (	1630	if (ecb_expect_true (
1418	cctx_current->idle_sp == STACKLEVEL	1631	cctx_current->idle_sp == STACKLEVEL
1419	&& !(cctx_current->flags & CC_TRACE)	1632	&& !(cctx_current->flags & CC_TRACE)
1420	&& !force_cctx	1633	&& !force_cctx
1421	))	1634	))
1422	{	1635	{
1423	/* I assume that stacklevel is a stronger indicator than PL_top_env changes */	1636	/* I assume that stacklevel is a stronger indicator than PL_top_env changes */
1424	assert (("FATAL: current top_env must equal previous top_env in Coro (please report)", PL_top_env == cctx_current->idle_te));	1637	assert (("FATAL: current top_env must equal previous top_env in Coro (please report)", PL_top_env == cctx_current->idle_te));
1425		1638
1426	/* if the cctx is about to be destroyed we need to make sure we won't see it in cctx_get. */	1639	/* if the cctx is about to be destroyed we need to make sure we won't see it in cctx_get. */
1427	/* without this the next cctx_get might destroy the running cctx while still in use */	1640	/* without this the next cctx_get might destroy the running cctx while still in use */
1428	if (expect_false (CCTX_EXPIRED (cctx_current)))	1641	if (ecb_expect_false (CCTX_EXPIRED (cctx_current)))
1429	if (expect_true (!next->cctx))	1642	if (ecb_expect_true (!next->cctx))
1430	next->cctx = cctx_get (aTHX);	1643	next->cctx = cctx_get (aTHX);
1431		1644
1432	cctx_put (cctx_current);	1645	cctx_put (cctx_current);
1433	}	1646	}
1434	else	1647	else
1435	prev->cctx = cctx_current;	1648	prev->cctx = cctx_current;
1436		1649
1437	++next->usecount;	1650	++next->usecount;
1438		1651
1439	cctx_prev = cctx_current;	1652	cctx_prev = cctx_current;
1440	cctx_current = expect_false (next->cctx) ? next->cctx : cctx_get (aTHX);	1653	cctx_current = ecb_expect_false (next->cctx) ? next->cctx : cctx_get (aTHX);
1441		1654
1442	next->cctx = 0;	1655	next->cctx = 0;
1443		1656
1444	if (expect_false (cctx_prev != cctx_current))	1657	if (ecb_expect_false (cctx_prev != cctx_current))
1445	{	1658	{
1446	cctx_prev->top_env = PL_top_env;	1659	cctx_prev->top_env = PL_top_env;
1447	PL_top_env = cctx_current->top_env;	1660	PL_top_env = cctx_current->top_env;
1448	coro_transfer (&cctx_prev->cctx, &cctx_current->cctx);	1661	coro_transfer (&cctx_prev->cctx, &cctx_current->cctx);
1449	}	1662	}
…		…
1455	#define TRANSFER(ta, force_cctx) transfer (aTHX_ (ta).prev, (ta).next, (force_cctx))	1668	#define TRANSFER(ta, force_cctx) transfer (aTHX_ (ta).prev, (ta).next, (force_cctx))
1456	#define TRANSFER_CHECK(ta) transfer_check (aTHX_ (ta).prev, (ta).next)	1669	#define TRANSFER_CHECK(ta) transfer_check (aTHX_ (ta).prev, (ta).next)
1457		1670
1458	/** high level stuff ********************************************************/	1671	/** high level stuff ********************************************************/
1459		1672
		1673	/* this function is actually Coro, not Coro::State, but we call it from here */
		1674	/* because it is convenient - but it hasn't been declared yet for that reason */
1460	static int	1675	static void
		1676	coro_call_on_destroy (pTHX_ struct coro *coro);
		1677
		1678	static void
1461	coro_state_destroy (pTHX_ struct coro *coro)	1679	coro_state_destroy (pTHX_ struct coro *coro)
1462	{	1680	{
1463	if (coro->flags & CF_DESTROYED)	1681	if (coro->flags & CF_ZOMBIE)
1464	return 0;	1682	return;
1465		1683
1466	if (coro->on_destroy)
1467	coro->on_destroy (aTHX_ coro);	1684	slf_destroy (aTHX_ coro);
1468		1685
1469	coro->flags |= CF_DESTROYED;	1686	coro->flags |= CF_ZOMBIE;
1470		1687
1471	if (coro->flags & CF_READY)	1688	if (coro->flags & CF_READY)
1472	{	1689	{
1473	/* reduce nready, as destroying a ready coro effectively unreadies it */	1690	/* reduce nready, as destroying a ready coro effectively unreadies it */
1474	/* alternative: look through all ready queues and remove the coro */	1691	/* alternative: look through all ready queues and remove the coro */
1475	--coro_nready;	1692	--coro_nready;
1476	}	1693	}
1477	else	1694	else
1478	coro->flags |= CF_READY; /* make sure it is NOT put into the readyqueue */	1695	coro->flags |= CF_READY; /* make sure it is NOT put into the readyqueue */
		1696
		1697	if (coro->next) coro->next->prev = coro->prev;
		1698	if (coro->prev) coro->prev->next = coro->next;
		1699	if (coro == coro_first) coro_first = coro->next;
1479		1700
1480	if (coro->mainstack	1701	if (coro->mainstack
1481	&& coro->mainstack != main_mainstack	1702	&& coro->mainstack != main_mainstack
1482	&& coro->slot	1703	&& coro->slot
1483	&& !PL_dirty)	1704	&& !PL_dirty)
1484	{
1485	struct coro temp;
1486
1487	assert (("FATAL: tried to destroy currently running coroutine", coro->mainstack != PL_mainstack));
1488
1489	save_perl (aTHX_ &temp);
1490	load_perl (aTHX_ coro);
1491
1492	coro_destruct_perl (aTHX_ coro);	1705	destroy_perl (aTHX_ coro);
1493
1494	load_perl (aTHX_ &temp);
1495
1496	coro->slot = 0;
1497	}
1498		1706
1499	cctx_destroy (coro->cctx);	1707	cctx_destroy (coro->cctx);
1500	SvREFCNT_dec (coro->startcv);	1708	SvREFCNT_dec (coro->startcv);
1501	SvREFCNT_dec (coro->args);	1709	SvREFCNT_dec (coro->args);
		1710	SvREFCNT_dec (coro->swap_sv);
1502	SvREFCNT_dec (CORO_THROW);	1711	SvREFCNT_dec (CORO_THROW);
1503		1712
1504	if (coro->next) coro->next->prev = coro->prev;	1713	coro_call_on_destroy (aTHX_ coro);
1505	if (coro->prev) coro->prev->next = coro->next;
1506	if (coro == coro_first) coro_first = coro->next;
1507		1714
1508	return 1;	1715	/* more destruction mayhem in coro_state_free */
1509	}	1716	}
1510		1717
1511	static int	1718	static int
1512	coro_state_free (pTHX_ SV *sv, MAGIC *mg)	1719	coro_state_free (pTHX_ SV *sv, MAGIC *mg)
1513	{	1720	{
1514	struct coro *coro = (struct coro *)mg->mg_ptr;	1721	struct coro *coro = (struct coro *)mg->mg_ptr;
1515	mg->mg_ptr = 0;	1722	mg->mg_ptr = 0;
1516		1723
1517	coro->hv = 0;
1518
1519	if (--coro->refcnt < 0)
1520	{
1521	coro_state_destroy (aTHX_ coro);	1724	coro_state_destroy (aTHX_ coro);
		1725	SvREFCNT_dec (coro->on_destroy);
		1726	SvREFCNT_dec (coro->status);
		1727
1522	Safefree (coro);	1728	Safefree (coro);
1523	}
1524		1729
1525	return 0;	1730	return 0;
1526	}	1731	}
1527		1732
1528	static int	1733	static int ecb_cold
1529	coro_state_dup (pTHX_ MAGIC *mg, CLONE_PARAMS *params)	1734	coro_state_dup (pTHX_ MAGIC *mg, CLONE_PARAMS *params)
1530	{	1735	{
1531	struct coro *coro = (struct coro *)mg->mg_ptr;	1736	/* called when perl clones the current process the slow way (windows process emulation) */
1532		1737	/* WE SIMply nuke the pointers in the copy, causing perl to croak */
1533	++coro->refcnt;	1738	mg->mg_ptr = 0;
		1739	mg->mg_virtual = 0;
1534		1740
1535	return 0;	1741	return 0;
1536	}	1742	}
1537		1743
1538	static MGVTBL coro_state_vtbl = {	1744	static MGVTBL coro_state_vtbl = {
…		…
1561		1767
1562	prepare_transfer (aTHX_ &ta, prev_sv, next_sv);	1768	prepare_transfer (aTHX_ &ta, prev_sv, next_sv);
1563	TRANSFER (ta, 1);	1769	TRANSFER (ta, 1);
1564	}	1770	}
1565		1771
1566	/*****************************************************************************/
1567	/* gensub: simple closure generation utility */
1568
1569	#define GENSUB_ARG CvXSUBANY (cv).any_ptr
1570
1571	/* create a closure from XS, returns a code reference */
1572	/* the arg can be accessed via GENSUB_ARG from the callback */
1573	/* the callback must use dXSARGS/XSRETURN */
1574	static SV *
1575	gensub (pTHX_ void (*xsub)(pTHX_ CV *), void *arg)
1576	{
1577	CV *cv = (CV *)newSV (0);
1578
1579	sv_upgrade ((SV *)cv, SVt_PVCV);
1580
1581	CvANON_on (cv);
1582	CvISXSUB_on (cv);
1583	CvXSUB (cv) = xsub;
1584	GENSUB_ARG = arg;
1585
1586	return newRV_noinc ((SV *)cv);
1587	}
1588
1589	/** Coro ********************************************************************/	1772	/** Coro ********************************************************************/
1590		1773
1591	INLINE void	1774	ecb_inline void
1592	coro_enq (pTHX_ struct coro *coro)	1775	coro_enq (pTHX_ struct coro *coro)
1593	{	1776	{
1594	av_push (coro_ready [coro->prio - PRIO_MIN], SvREFCNT_inc_NN (coro->hv));	1777	struct coro **ready = coro_ready [coro->prio - CORO_PRIO_MIN];
1595	}
1596		1778
1597	INLINE SV *	1779	SvREFCNT_inc_NN (coro->hv);
		1780
		1781	coro->next_ready = 0;
		1782	*(ready [0] ? &ready [1]->next_ready : &ready [0]) = coro;
		1783	ready [1] = coro;
		1784	}
		1785
		1786	ecb_inline struct coro *
1598	coro_deq (pTHX)	1787	coro_deq (pTHX)
1599	{	1788	{
1600	int prio;	1789	int prio;
1601		1790
1602	for (prio = PRIO_MAX - PRIO_MIN + 1; --prio >= 0; )	1791	for (prio = CORO_PRIO_MAX - CORO_PRIO_MIN + 1; --prio >= 0; )
1603	if (AvFILLp (coro_ready [prio]) >= 0)	1792	{
1604	return av_shift (coro_ready [prio]);	1793	struct coro **ready = coro_ready [prio];
		1794
		1795	if (ready [0])
		1796	{
		1797	struct coro *coro = ready [0];
		1798	ready [0] = coro->next_ready;
		1799	return coro;
		1800	}
		1801	}
1605		1802
1606	return 0;	1803	return 0;
		1804	}
		1805
		1806	static void
		1807	invoke_sv_ready_hook_helper (void)
		1808	{
		1809	dTHX;
		1810	dSP;
		1811
		1812	ENTER;
		1813	SAVETMPS;
		1814
		1815	PUSHMARK (SP);
		1816	PUTBACK;
		1817	call_sv (coro_readyhook, G_VOID | G_DISCARD);
		1818
		1819	FREETMPS;
		1820	LEAVE;
1607	}	1821	}
1608		1822
1609	static int	1823	static int
1610	api_ready (pTHX_ SV *coro_sv)	1824	api_ready (pTHX_ SV *coro_sv)
1611	{	1825	{
1612	struct coro *coro;
1613	SV *sv_hook;
1614	void (*xs_hook)(void);
1615
1616	coro = SvSTATE (coro_sv);	1826	struct coro *coro = SvSTATE (coro_sv);
1617		1827
1618	if (coro->flags & CF_READY)	1828	if (coro->flags & CF_READY)
1619	return 0;	1829	return 0;
1620		1830
1621	coro->flags |= CF_READY;	1831	coro->flags |= CF_READY;
1622		1832
1623	sv_hook = coro_nready ? 0 : coro_readyhook;
1624	xs_hook = coro_nready ? 0 : coroapi.readyhook;
1625
1626	coro_enq (aTHX_ coro);	1833	coro_enq (aTHX_ coro);
1627	++coro_nready;
1628		1834
1629	if (sv_hook)	1835	if (!coro_nready++)
1630	{	1836	if (coroapi.readyhook)
1631	dSP;	1837	coroapi.readyhook ();
1632
1633	ENTER;
1634	SAVETMPS;
1635
1636	PUSHMARK (SP);
1637	PUTBACK;
1638	call_sv (sv_hook, G_VOID | G_DISCARD);
1639
1640	FREETMPS;
1641	LEAVE;
1642	}
1643
1644	if (xs_hook)
1645	xs_hook ();
1646		1838
1647	return 1;	1839	return 1;
1648	}	1840	}
1649		1841
1650	static int	1842	static int
…		…
1652	{	1844	{
1653	return !!(SvSTATE (coro_sv)->flags & CF_READY);	1845	return !!(SvSTATE (coro_sv)->flags & CF_READY);
1654	}	1846	}
1655		1847
1656	/* expects to own a reference to next->hv */	1848	/* expects to own a reference to next->hv */
1657	INLINE void	1849	ecb_inline void
1658	prepare_schedule_to (pTHX_ struct coro_transfer_args *ta, struct coro *next)	1850	prepare_schedule_to (pTHX_ struct coro_transfer_args *ta, struct coro *next)
1659	{	1851	{
1660	SV *prev_sv = SvRV (coro_current);	1852	SV *prev_sv = SvRV (coro_current);
1661		1853
1662	ta->prev = SvSTATE_hv (prev_sv);	1854	ta->prev = SvSTATE_hv (prev_sv);
…		…
1673	static void	1865	static void
1674	prepare_schedule (pTHX_ struct coro_transfer_args *ta)	1866	prepare_schedule (pTHX_ struct coro_transfer_args *ta)
1675	{	1867	{
1676	for (;;)	1868	for (;;)
1677	{	1869	{
1678	SV *next_sv = coro_deq (aTHX);	1870	struct coro *next = coro_deq (aTHX);
1679		1871
1680	if (expect_true (next_sv))	1872	if (ecb_expect_true (next))
1681	{	1873	{
1682	struct coro *next = SvSTATE_hv (next_sv);
1683
1684	/* cannot transfer to destroyed coros, skip and look for next */	1874	/* cannot transfer to destroyed coros, skip and look for next */
1685	if (expect_false (next->flags & CF_DESTROYED))	1875	if (ecb_expect_false (next->flags & (CF_ZOMBIE | CF_SUSPENDED)))
1686	SvREFCNT_dec (next_sv); /* coro_nready has already been taken care of by destroy */	1876	SvREFCNT_dec (next->hv); /* coro_nready has already been taken care of by destroy */
1687	else	1877	else
1688	{	1878	{
1689	next->flags &= ~CF_READY;	1879	next->flags &= ~CF_READY;
1690	--coro_nready;	1880	--coro_nready;
1691		1881
…		…
1697	{	1887	{
1698	/* nothing to schedule: call the idle handler */	1888	/* nothing to schedule: call the idle handler */
1699	if (SvROK (sv_idle)	1889	if (SvROK (sv_idle)
1700	&& SvOBJECT (SvRV (sv_idle)))	1890	&& SvOBJECT (SvRV (sv_idle)))
1701	{	1891	{
		1892	if (SvRV (sv_idle) == SvRV (coro_current))
		1893	croak ("FATAL: $Coro::IDLE blocked itself - did you try to block inside an event loop callback? Caught");
		1894
1702	++coro_nready; /* hack so that api_ready doesn't invoke ready hook */	1895	++coro_nready; /* hack so that api_ready doesn't invoke ready hook */
1703	api_ready (aTHX_ SvRV (sv_idle));	1896	api_ready (aTHX_ SvRV (sv_idle));
1704	--coro_nready;	1897	--coro_nready;
1705	}	1898	}
1706	else	1899	else
1707	{	1900	{
		1901	/* TODO: deprecated, remove, cannot work reliably *//*D*/
1708	dSP;	1902	dSP;
1709		1903
1710	ENTER;	1904	ENTER;
1711	SAVETMPS;	1905	SAVETMPS;
1712		1906
…		…
1719	}	1913	}
1720	}	1914	}
1721	}	1915	}
1722	}	1916	}
1723		1917
1724	INLINE void	1918	ecb_inline void
1725	prepare_cede (pTHX_ struct coro_transfer_args *ta)	1919	prepare_cede (pTHX_ struct coro_transfer_args *ta)
1726	{	1920	{
1727	api_ready (aTHX_ coro_current);	1921	api_ready (aTHX_ coro_current);
1728	prepare_schedule (aTHX_ ta);	1922	prepare_schedule (aTHX_ ta);
1729	}	1923	}
1730		1924
1731	INLINE void	1925	ecb_inline void
1732	prepare_cede_notself (pTHX_ struct coro_transfer_args *ta)	1926	prepare_cede_notself (pTHX_ struct coro_transfer_args *ta)
1733	{	1927	{
1734	SV *prev = SvRV (coro_current);	1928	SV *prev = SvRV (coro_current);
1735		1929
1736	if (coro_nready)	1930	if (coro_nready)
…		…
1766	{	1960	{
1767	struct coro_transfer_args ta;	1961	struct coro_transfer_args ta;
1768		1962
1769	prepare_cede (aTHX_ &ta);	1963	prepare_cede (aTHX_ &ta);
1770		1964
1771	if (expect_true (ta.prev != ta.next))	1965	if (ecb_expect_true (ta.prev != ta.next))
1772	{	1966	{
1773	TRANSFER (ta, 1);	1967	TRANSFER (ta, 1);
1774	return 1;	1968	return 1;
1775	}	1969	}
1776	else	1970	else
…		…
1819	coro->slot->runops = RUNOPS_DEFAULT;	2013	coro->slot->runops = RUNOPS_DEFAULT;
1820	}	2014	}
1821	}	2015	}
1822		2016
1823	static void	2017	static void
		2018	coro_push_av (pTHX_ AV *av, I32 gimme_v)
		2019	{
		2020	if (AvFILLp (av) >= 0 && gimme_v != G_VOID)
		2021	{
		2022	dSP;
		2023
		2024	if (gimme_v == G_SCALAR)
		2025	XPUSHs (AvARRAY (av)[AvFILLp (av)]);
		2026	else
		2027	{
		2028	int i;
		2029	EXTEND (SP, AvFILLp (av) + 1);
		2030
		2031	for (i = 0; i <= AvFILLp (av); ++i)
		2032	PUSHs (AvARRAY (av)[i]);
		2033	}
		2034
		2035	PUTBACK;
		2036	}
		2037	}
		2038
		2039	static void
		2040	coro_push_on_destroy (pTHX_ struct coro *coro, SV *cb)
		2041	{
		2042	if (!coro->on_destroy)
		2043	coro->on_destroy = newAV ();
		2044
		2045	av_push (coro->on_destroy, cb);
		2046	}
		2047
		2048	static void
		2049	slf_destroy_join (pTHX_ struct CoroSLF *frame)
		2050	{
		2051	SvREFCNT_dec ((SV *)((struct coro *)frame->data)->hv);
		2052	}
		2053
		2054	static int
		2055	slf_check_join (pTHX_ struct CoroSLF *frame)
		2056	{
		2057	struct coro *coro = (struct coro *)frame->data;
		2058
		2059	if (!coro->status)
		2060	return 1;
		2061
		2062	frame->destroy = 0;
		2063
		2064	coro_push_av (aTHX_ coro->status, GIMME_V);
		2065
		2066	SvREFCNT_dec ((SV *)coro->hv);
		2067
		2068	return 0;
		2069	}
		2070
		2071	static void
		2072	slf_init_join (pTHX_ struct CoroSLF *frame, CV *cv, SV **arg, int items)
		2073	{
		2074	struct coro *coro = SvSTATE (items > 0 ? arg [0] : &PL_sv_undef);
		2075
		2076	if (items > 1)
		2077	croak ("join called with too many arguments");
		2078
		2079	if (coro->status)
		2080	frame->prepare = prepare_nop;
		2081	else
		2082	{
		2083	coro_push_on_destroy (aTHX_ coro, SvREFCNT_inc_NN (SvRV (coro_current)));
		2084	frame->prepare = prepare_schedule;
		2085	}
		2086
		2087	frame->check = slf_check_join;
		2088	frame->destroy = slf_destroy_join;
		2089	frame->data = (void *)coro;
		2090	SvREFCNT_inc (coro->hv);
		2091	}
		2092
		2093	static void
1824	coro_call_on_destroy (pTHX_ struct coro *coro)	2094	coro_call_on_destroy (pTHX_ struct coro *coro)
1825	{	2095	{
1826	SV **on_destroyp = hv_fetch (coro->hv, "_on_destroy", sizeof ("_on_destroy") - 1, 0);	2096	AV *od = coro->on_destroy;
1827	SV **statusp = hv_fetch (coro->hv, "_status", sizeof ("_status") - 1, 0);
1828		2097
1829	if (on_destroyp)	2098	if (!od)
1830	{	2099	return;
1831	AV *on_destroy = (AV *)SvRV (*on_destroyp);
1832		2100
		2101	coro->on_destroy = 0;
		2102	sv_2mortal ((SV *)od);
		2103
1833	while (AvFILLp (on_destroy) >= 0)	2104	while (AvFILLp (od) >= 0)
		2105	{
		2106	SV *cb = sv_2mortal (av_pop (od));
		2107
		2108	/* coro hv's (and only hv's at the moment) are supported as well */
		2109	if (SvSTATEhv_p (aTHX_ cb))
		2110	api_ready (aTHX_ cb);
		2111	else
1834	{	2112	{
1835	dSP; /* don't disturb outer sp */	2113	dSP; /* don't disturb outer sp */
1836	SV *cb = av_pop (on_destroy);
1837
1838	PUSHMARK (SP);	2114	PUSHMARK (SP);
1839		2115
1840	if (statusp)	2116	if (coro->status)
1841	{	2117	{
1842	int i;	2118	PUTBACK;
1843	AV *status = (AV *)SvRV (*statusp);	2119	coro_push_av (aTHX_ coro->status, G_ARRAY);
1844	EXTEND (SP, AvFILLp (status) + 1);	2120	SPAGAIN;
1845
1846	for (i = 0; i <= AvFILLp (status); ++i)
1847	PUSHs (AvARRAY (status)[i]);
1848	}	2121	}
1849		2122
1850	PUTBACK;	2123	PUTBACK;
1851	call_sv (sv_2mortal (cb), G_VOID | G_DISCARD);	2124	call_sv (cb, G_VOID | G_DISCARD);
1852	}	2125	}
1853	}	2126	}
1854	}	2127	}
1855		2128
1856	static void	2129	static void
1857	slf_init_terminate (pTHX_ struct CoroSLF *frame, CV *cv, SV **arg, int items)	2130	coro_set_status (pTHX_ struct coro *coro, SV **arg, int items)
1858	{	2131	{
		2132	AV *av;
		2133
		2134	if (coro->status)
		2135	{
		2136	av = coro->status;
		2137	av_clear (av);
		2138	}
		2139	else
		2140	av = coro->status = newAV ();
		2141
		2142	/* items are actually not so common, so optimise for this case */
		2143	if (items)
		2144	{
1859	int i;	2145	int i;
1860	HV *hv = (HV *)SvRV (coro_current);
1861	AV *av = newAV ();
1862		2146
1863	av_extend (av, items - 1);	2147	av_extend (av, items - 1);
		2148
1864	for (i = 0; i < items; ++i)	2149	for (i = 0; i < items; ++i)
1865	av_push (av, SvREFCNT_inc_NN (arg [i]));	2150	av_push (av, SvREFCNT_inc_NN (arg [i]));
		2151	}
		2152	}
1866		2153
1867	hv_store (hv, "_status", sizeof ("_status") - 1, newRV_noinc ((SV *)av), 0);	2154	static void
1868		2155	slf_init_terminate_cancel_common (pTHX_ struct CoroSLF *frame, HV *coro_hv)
		2156	{
1869	av_push (av_destroy, (SV *)newRV_inc ((SV *)hv)); /* RVinc for perl */	2157	av_push (av_destroy, (SV *)newRV_inc ((SV *)coro_hv)); /* RVinc for perl */
1870	api_ready (aTHX_ sv_manager);	2158	api_ready (aTHX_ sv_manager);
1871		2159
1872	frame->prepare = prepare_schedule;	2160	frame->prepare = prepare_schedule;
1873	frame->check = slf_check_repeat;	2161	frame->check = slf_check_repeat;
1874		2162
1875	/* as a minor optimisation, we could unwind all stacks here */	2163	/* as a minor optimisation, we could unwind all stacks here */
1876	/* but that puts extra pressure on pp_slf, and is not worth much */	2164	/* but that puts extra pressure on pp_slf, and is not worth much */
1877	/*coro_unwind_stacks (aTHX);*/	2165	/*coro_unwind_stacks (aTHX);*/
		2166	}
		2167
		2168	static void
		2169	slf_init_terminate (pTHX_ struct CoroSLF *frame, CV *cv, SV **arg, int items)
		2170	{
		2171	HV *coro_hv = (HV *)SvRV (coro_current);
		2172
		2173	coro_set_status (aTHX_ SvSTATE ((SV *)coro_hv), arg, items);
		2174	slf_init_terminate_cancel_common (aTHX_ frame, coro_hv);
		2175	}
		2176
		2177	static void
		2178	slf_init_cancel (pTHX_ struct CoroSLF *frame, CV *cv, SV **arg, int items)
		2179	{
		2180	HV *coro_hv;
		2181	struct coro *coro;
		2182
		2183	if (items <= 0)
		2184	croak ("Coro::cancel called without coro object,");
		2185
		2186	coro = SvSTATE (arg [0]);
		2187	coro_hv = coro->hv;
		2188
		2189	coro_set_status (aTHX_ coro, arg + 1, items - 1);
		2190
		2191	if (ecb_expect_false (coro->flags & CF_NOCANCEL))
		2192	{
		2193	/* coro currently busy cancelling something, so just notify it */
		2194	coro->slf_frame.data = (void *)coro;
		2195
		2196	frame->prepare = prepare_nop;
		2197	frame->check = slf_check_nop;
		2198	}
		2199	else if (coro_hv == (HV *)SvRV (coro_current))
		2200	{
		2201	/* cancelling the current coro is allowed, and equals terminate */
		2202	slf_init_terminate_cancel_common (aTHX_ frame, coro_hv);
		2203	}
		2204	else
		2205	{
		2206	struct coro *self = SvSTATE_current;
		2207
		2208	/* otherwise we cancel directly, purely for speed reasons
		2209	* unfortunately, this requires some magic trickery, as
		2210	* somebody else could cancel us, so we have to fight the cancellation.
		2211	* this is ugly, and hopefully fully worth the extra speed.
		2212	* besides, I can't get the slow-but-safe version working...
		2213	*/
		2214	slf_frame.data = 0;
		2215	self->flags |= CF_NOCANCEL;
		2216	coro_state_destroy (aTHX_ coro);
		2217	self->flags &= ~CF_NOCANCEL;
		2218
		2219	if (slf_frame.data)
		2220	{
		2221	/* while we were busy we have been cancelled, so terminate */
		2222	slf_init_terminate_cancel_common (aTHX_ frame, self->hv);
		2223	}
		2224	else
		2225	{
		2226	frame->prepare = prepare_nop;
		2227	frame->check = slf_check_nop;
		2228	}
		2229	}
		2230	}
		2231
		2232	static int
		2233	slf_check_safe_cancel (pTHX_ struct CoroSLF *frame)
		2234	{
		2235	frame->prepare = 0;
		2236	coro_unwind_stacks (aTHX);
		2237
		2238	slf_init_terminate_cancel_common (aTHX_ frame, (HV *)SvRV (coro_current));
		2239
		2240	return 1;
		2241	}
		2242
		2243	static int
		2244	safe_cancel (pTHX_ struct coro *coro, SV **arg, int items)
		2245	{
		2246	if (coro->cctx)
		2247	croak ("coro inside C callback, unable to cancel at this time, caught");
		2248
		2249	if (coro->flags & CF_NEW)
		2250	{
		2251	coro_set_status (aTHX_ coro, arg, items);
		2252	coro_state_destroy (aTHX_ coro);
		2253	}
		2254	else
		2255	{
		2256	if (!coro->slf_frame.prepare)
		2257	croak ("coro outside an SLF function, unable to cancel at this time, caught");
		2258
		2259	slf_destroy (aTHX_ coro);
		2260
		2261	coro_set_status (aTHX_ coro, arg, items);
		2262	coro->slf_frame.prepare = prepare_nop;
		2263	coro->slf_frame.check = slf_check_safe_cancel;
		2264
		2265	api_ready (aTHX_ (SV *)coro->hv);
		2266	}
		2267
		2268	return 1;
1878	}	2269	}
1879		2270
1880	/*****************************************************************************/	2271	/*****************************************************************************/
1881	/* async pool handler */	2272	/* async pool handler */
1882		2273
…		…
1913	slf_init_pool_handler (pTHX_ struct CoroSLF *frame, CV *cv, SV **arg, int items)	2304	slf_init_pool_handler (pTHX_ struct CoroSLF *frame, CV *cv, SV **arg, int items)
1914	{	2305	{
1915	HV *hv = (HV *)SvRV (coro_current);	2306	HV *hv = (HV *)SvRV (coro_current);
1916	struct coro *coro = SvSTATE_hv ((SV *)hv);	2307	struct coro *coro = SvSTATE_hv ((SV *)hv);
1917		2308
1918	if (expect_true (coro->saved_deffh))	2309	if (ecb_expect_true (coro->saved_deffh))
1919	{	2310	{
1920	/* subsequent iteration */	2311	/* subsequent iteration */
1921	SvREFCNT_dec ((SV *)PL_defoutgv); PL_defoutgv = (GV *)coro->saved_deffh;	2312	SvREFCNT_dec ((SV *)PL_defoutgv); PL_defoutgv = (GV *)coro->saved_deffh;
1922	coro->saved_deffh = 0;	2313	coro->saved_deffh = 0;
1923		2314
1924	if (coro_rss (aTHX_ coro) > SvUV (sv_pool_rss)	2315	if (coro_rss (aTHX_ coro) > SvUV (sv_pool_rss)
1925	|| av_len (av_async_pool) + 1 >= SvIV (sv_pool_size))	2316	|| av_len (av_async_pool) + 1 >= SvIV (sv_pool_size))
1926	{	2317	{
1927	coro->invoke_cb = SvREFCNT_inc_NN ((SV *)cv_coro_terminate);	2318	slf_init_terminate_cancel_common (aTHX_ frame, hv);
1928	coro->invoke_av = newAV ();	2319	return;
1929
1930	frame->prepare = prepare_nop;
1931	}	2320	}
1932	else	2321	else
1933	{	2322	{
1934	av_clear (GvAV (PL_defgv));	2323	av_clear (GvAV (PL_defgv));
1935	hv_store (hv, "desc", sizeof ("desc") - 1, SvREFCNT_inc_NN (sv_async_pool_idle), 0);	2324	hv_store (hv, "desc", sizeof ("desc") - 1, SvREFCNT_inc_NN (sv_async_pool_idle), 0);
…		…
1960		2349
1961	static void	2350	static void
1962	coro_rouse_callback (pTHX_ CV *cv)	2351	coro_rouse_callback (pTHX_ CV *cv)
1963	{	2352	{
1964	dXSARGS;	2353	dXSARGS;
1965	SV *data = (SV *)GENSUB_ARG;	2354	SV *data = (SV *)S_GENSUB_ARG;
1966		2355
1967	if (SvTYPE (SvRV (data)) != SVt_PVAV)	2356	if (SvTYPE (SvRV (data)) != SVt_PVAV)
1968	{	2357	{
1969	/* first call, set args */	2358	/* first call, set args */
		2359	SV *coro = SvRV (data);
1970	AV *av = newAV ();	2360	AV *av = newAV ();
1971	SV *coro = SvRV (data);
1972		2361
1973	SvRV_set (data, (SV *)av);	2362	SvRV_set (data, (SV *)av);
1974	api_ready (aTHX_ coro);
1975	SvREFCNT_dec (coro);
1976		2363
1977	/* better take a full copy of the arguments */	2364	/* better take a full copy of the arguments */
1978	while (items--)	2365	while (items--)
1979	av_store (av, items, newSVsv (ST (items)));	2366	av_store (av, items, newSVsv (ST (items)));
		2367
		2368	api_ready (aTHX_ coro);
		2369	SvREFCNT_dec (coro);
1980	}	2370	}
1981		2371
1982	XSRETURN_EMPTY;	2372	XSRETURN_EMPTY;
1983	}	2373	}
1984		2374
1985	static int	2375	static int
1986	slf_check_rouse_wait (pTHX_ struct CoroSLF *frame)	2376	slf_check_rouse_wait (pTHX_ struct CoroSLF *frame)
1987	{	2377	{
1988	SV *data = (SV *)frame->data;	2378	SV *data = (SV *)frame->data;
1989		2379
1990	if (CORO_THROW)	2380	if (CORO_THROW)
1991	return 0;	2381	return 0;
1992		2382
1993	if (SvTYPE (SvRV (data)) != SVt_PVAV)	2383	if (SvTYPE (SvRV (data)) != SVt_PVAV)
1994	return 1;	2384	return 1;
…		…
2001		2391
2002	EXTEND (SP, AvFILLp (av) + 1);	2392	EXTEND (SP, AvFILLp (av) + 1);
2003	for (i = 0; i <= AvFILLp (av); ++i)	2393	for (i = 0; i <= AvFILLp (av); ++i)
2004	PUSHs (sv_2mortal (AvARRAY (av)[i]));	2394	PUSHs (sv_2mortal (AvARRAY (av)[i]));
2005		2395
2006	/* we have stolen the elements, so ste length to zero and free */	2396	/* we have stolen the elements, so set length to zero and free */
2007	AvFILLp (av) = -1;	2397	AvFILLp (av) = -1;
2008	av_undef (av);	2398	av_undef (av);
2009		2399
2010	PUTBACK;	2400	PUTBACK;
2011	}	2401	}
…		…
2030	cb = sv_2mortal (coro->rouse_cb);	2420	cb = sv_2mortal (coro->rouse_cb);
2031	coro->rouse_cb = 0;	2421	coro->rouse_cb = 0;
2032	}	2422	}
2033		2423
2034	if (!SvROK (cb)	2424	if (!SvROK (cb)
2035	|| SvTYPE (SvRV (cb)) != SVt_PVCV	2425	|| SvTYPE (SvRV (cb)) != SVt_PVCV
2036	|| CvXSUB ((CV *)SvRV (cb)) != coro_rouse_callback)	2426	|| CvXSUB ((CV *)SvRV (cb)) != coro_rouse_callback)
2037	croak ("Coro::rouse_wait called with illegal callback argument,");	2427	croak ("Coro::rouse_wait called with illegal callback argument,");
2038		2428
2039	{	2429	{
2040	CV *cv = (CV *)SvRV (cb); /* for GENSUB_ARG */	2430	CV *cv = (CV *)SvRV (cb); /* for S_GENSUB_ARG */
2041	SV *data = (SV *)GENSUB_ARG;	2431	SV *data = (SV *)S_GENSUB_ARG;
2042		2432
2043	frame->data = (void *)data;	2433	frame->data = (void *)data;
2044	frame->prepare = SvTYPE (SvRV (data)) == SVt_PVAV ? prepare_nop : prepare_schedule;	2434	frame->prepare = SvTYPE (SvRV (data)) == SVt_PVAV ? prepare_nop : prepare_schedule;
2045	frame->check = slf_check_rouse_wait;	2435	frame->check = slf_check_rouse_wait;
2046	}	2436	}
…		…
2050	coro_new_rouse_cb (pTHX)	2440	coro_new_rouse_cb (pTHX)
2051	{	2441	{
2052	HV *hv = (HV *)SvRV (coro_current);	2442	HV *hv = (HV *)SvRV (coro_current);
2053	struct coro *coro = SvSTATE_hv (hv);	2443	struct coro *coro = SvSTATE_hv (hv);
2054	SV *data = newRV_inc ((SV *)hv);	2444	SV *data = newRV_inc ((SV *)hv);
2055	SV *cb = gensub (aTHX_ coro_rouse_callback, (void *)data);	2445	SV *cb = s_gensub (aTHX_ coro_rouse_callback, (void *)data);
2056		2446
2057	sv_magicext (SvRV (cb), data, CORO_MAGIC_type_rouse, 0, 0, 0);	2447	sv_magicext (SvRV (cb), data, CORO_MAGIC_type_rouse, 0, 0, 0);
2058	SvREFCNT_dec (data); /* magicext increases the refcount */	2448	SvREFCNT_dec (data); /* magicext increases the refcount */
2059		2449
2060	SvREFCNT_dec (coro->rouse_cb);	2450	SvREFCNT_dec (coro->rouse_cb);
…		…
2157	static void	2547	static void
2158	slf_init_cede_notself (pTHX_ struct CoroSLF *frame, CV *cv, SV **arg, int items)	2548	slf_init_cede_notself (pTHX_ struct CoroSLF *frame, CV *cv, SV **arg, int items)
2159	{	2549	{
2160	frame->prepare = prepare_cede_notself;	2550	frame->prepare = prepare_cede_notself;
2161	frame->check = slf_check_nop;	2551	frame->check = slf_check_nop;
		2552	}
		2553
		2554	/* "undo"/cancel a running slf call - used when cancelling a coro, mainly */
		2555	static void
		2556	slf_destroy (pTHX_ struct coro *coro)
		2557	{
		2558	/* this callback is reserved for slf functions needing to do cleanup */
		2559	if (coro->slf_frame.destroy && coro->slf_frame.prepare && !PL_dirty)
		2560	coro->slf_frame.destroy (aTHX_ &coro->slf_frame);
		2561
		2562	/*
		2563	* The on_destroy above most likely is from an SLF call.
		2564	* Since by definition the SLF call will not finish when we destroy
		2565	* the coro, we will have to force-finish it here, otherwise
		2566	* cleanup functions cannot call SLF functions.
		2567	*/
		2568	coro->slf_frame.prepare = 0;
2162	}	2569	}
2163		2570
2164	/*	2571	/*
2165	* these not obviously related functions are all rolled into one	2572	* these not obviously related functions are all rolled into one
2166	* function to increase chances that they all will call transfer with the same	2573	* function to increase chances that they all will call transfer with the same
…		…
2173	I32 checkmark; /* mark SP to see how many elements check has pushed */	2580	I32 checkmark; /* mark SP to see how many elements check has pushed */
2174		2581
2175	/* set up the slf frame, unless it has already been set-up */	2582	/* set up the slf frame, unless it has already been set-up */
2176	/* the latter happens when a new coro has been started */	2583	/* the latter happens when a new coro has been started */
2177	/* or when a new cctx was attached to an existing coroutine */	2584	/* or when a new cctx was attached to an existing coroutine */
2178	if (expect_true (!slf_frame.prepare))	2585	if (ecb_expect_true (!slf_frame.prepare))
2179	{	2586	{
2180	/* first iteration */	2587	/* first iteration */
2181	dSP;	2588	dSP;
2182	SV **arg = PL_stack_base + TOPMARK + 1;	2589	SV **arg = PL_stack_base + TOPMARK + 1;
2183	int items = SP - arg; /* args without function object */	2590	int items = SP - arg; /* args without function object */
…		…
2224	while (slf_frame.check (aTHX_ &slf_frame));	2631	while (slf_frame.check (aTHX_ &slf_frame));
2225		2632
2226	slf_frame.prepare = 0; /* invalidate the frame, we are done processing it */	2633	slf_frame.prepare = 0; /* invalidate the frame, we are done processing it */
2227		2634
2228	/* exception handling */	2635	/* exception handling */
2229	if (expect_false (CORO_THROW))	2636	if (ecb_expect_false (CORO_THROW))
2230	{	2637	{
2231	SV *exception = sv_2mortal (CORO_THROW);	2638	SV *exception = sv_2mortal (CORO_THROW);
2232		2639
2233	CORO_THROW = 0;	2640	CORO_THROW = 0;
2234	sv_setsv (ERRSV, exception);	2641	sv_setsv (ERRSV, exception);
2235	croak (0);	2642	croak (0);
2236	}	2643	}
2237		2644
2238	/* return value handling - mostly like entersub */	2645	/* return value handling - mostly like entersub */
2239	/* make sure we put something on the stack in scalar context */	2646	/* make sure we put something on the stack in scalar context */
2240	if (GIMME_V == G_SCALAR)	2647	if (GIMME_V == G_SCALAR
		2648	&& ecb_expect_false (PL_stack_sp != PL_stack_base + checkmark + 1))
2241	{	2649	{
2242	dSP;	2650	dSP;
2243	SV **bot = PL_stack_base + checkmark;	2651	SV **bot = PL_stack_base + checkmark;
2244		2652
2245	if (sp == bot) /* too few, push undef */	2653	if (sp == bot) /* too few, push undef */
2246	bot [1] = &PL_sv_undef;	2654	bot [1] = &PL_sv_undef;
2247	else if (sp != bot + 1) /* too many, take last one */	2655	else /* too many, take last one */
2248	bot [1] = *sp;	2656	bot [1] = *sp;
2249		2657
2250	SP = bot + 1;	2658	SP = bot + 1;
2251		2659
2252	PUTBACK;	2660	PUTBACK;
…		…
2285	if (PL_op->op_flags & OPf_STACKED)	2693	if (PL_op->op_flags & OPf_STACKED)
2286	{	2694	{
2287	if (items > slf_arga)	2695	if (items > slf_arga)
2288	{	2696	{
2289	slf_arga = items;	2697	slf_arga = items;
2290	free (slf_argv);	2698	Safefree (slf_argv);
2291	slf_argv = malloc (slf_arga * sizeof (SV *));	2699	New (0, slf_argv, slf_arga, SV *);
2292	}	2700	}
2293		2701
2294	slf_argc = items;	2702	slf_argc = items;
2295		2703
2296	for (i = 0; i < items; ++i)	2704	for (i = 0; i < items; ++i)
…		…
2301		2709
2302	PL_op->op_ppaddr = pp_slf;	2710	PL_op->op_ppaddr = pp_slf;
2303	/*PL_op->op_type = OP_CUSTOM; /* we do behave like entersub still */	2711	/*PL_op->op_type = OP_CUSTOM; /* we do behave like entersub still */
2304		2712
2305	PL_op = (OP *)&slf_restore;	2713	PL_op = (OP *)&slf_restore;
		2714	}
		2715
		2716	/*****************************************************************************/
		2717	/* dynamic wind */
		2718
		2719	static void
		2720	on_enterleave_call (pTHX_ SV *cb)
		2721	{
		2722	dSP;
		2723
		2724	PUSHSTACK;
		2725
		2726	PUSHMARK (SP);
		2727	PUTBACK;
		2728	call_sv (cb, G_VOID | G_DISCARD);
		2729	SPAGAIN;
		2730
		2731	POPSTACK;
		2732	}
		2733
		2734	static SV *
		2735	coro_avp_pop_and_free (pTHX_ AV **avp)
		2736	{
		2737	AV *av = *avp;
		2738	SV *res = av_pop (av);
		2739
		2740	if (AvFILLp (av) < 0)
		2741	{
		2742	*avp = 0;
		2743	SvREFCNT_dec (av);
		2744	}
		2745
		2746	return res;
		2747	}
		2748
		2749	static void
		2750	coro_pop_on_enter (pTHX_ void *coro)
		2751	{
		2752	SV *cb = coro_avp_pop_and_free (aTHX_ &((struct coro *)coro)->on_enter);
		2753	SvREFCNT_dec (cb);
		2754	}
		2755
		2756	static void
		2757	coro_pop_on_leave (pTHX_ void *coro)
		2758	{
		2759	SV *cb = coro_avp_pop_and_free (aTHX_ &((struct coro *)coro)->on_leave);
		2760	on_enterleave_call (aTHX_ sv_2mortal (cb));
2306	}	2761	}
2307		2762
2308	/*****************************************************************************/	2763	/*****************************************************************************/
2309	/* PerlIO::cede */	2764	/* PerlIO::cede */
2310		2765
…		…
2312	{	2767	{
2313	PerlIOBuf base;	2768	PerlIOBuf base;
2314	NV next, every;	2769	NV next, every;
2315	} PerlIOCede;	2770	} PerlIOCede;
2316		2771
2317	static IV	2772	static IV ecb_cold
2318	PerlIOCede_pushed (pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab)	2773	PerlIOCede_pushed (pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab)
2319	{	2774	{
2320	PerlIOCede *self = PerlIOSelf (f, PerlIOCede);	2775	PerlIOCede *self = PerlIOSelf (f, PerlIOCede);
2321		2776
2322	self->every = SvCUR (arg) ? SvNV (arg) : 0.01;	2777	self->every = SvCUR (arg) ? SvNV (arg) : 0.01;
2323	self->next = nvtime () + self->every;	2778	self->next = nvtime () + self->every;
2324		2779
2325	return PerlIOBuf_pushed (aTHX_ f, mode, Nullsv, tab);	2780	return PerlIOBuf_pushed (aTHX_ f, mode, Nullsv, tab);
2326	}	2781	}
2327		2782
2328	static SV *	2783	static SV * ecb_cold
2329	PerlIOCede_getarg (pTHX_ PerlIO *f, CLONE_PARAMS *param, int flags)	2784	PerlIOCede_getarg (pTHX_ PerlIO *f, CLONE_PARAMS *param, int flags)
2330	{	2785	{
2331	PerlIOCede *self = PerlIOSelf (f, PerlIOCede);	2786	PerlIOCede *self = PerlIOSelf (f, PerlIOCede);
2332		2787
2333	return newSVnv (self->every);	2788	return newSVnv (self->every);
…		…
2384	/* Coro::Semaphore & Coro::Signal */	2839	/* Coro::Semaphore & Coro::Signal */
2385		2840
2386	static SV *	2841	static SV *
2387	coro_waitarray_new (pTHX_ int count)	2842	coro_waitarray_new (pTHX_ int count)
2388	{	2843	{
2389	/* a semaphore contains a counter IV in $sem->[0] and any waiters after that */	2844	/* a waitarray=semaphore contains a counter IV in $sem->[0] and any waiters after that */
2390	AV *av = newAV ();	2845	AV *av = newAV ();
2391	SV **ary;	2846	SV **ary;
2392		2847
2393	/* unfortunately, building manually saves memory */	2848	/* unfortunately, building manually saves memory */
2394	Newx (ary, 2, SV *);	2849	Newx (ary, 2, SV *);
…		…
2445	SvREFCNT_dec (cb);	2900	SvREFCNT_dec (cb);
2446	}	2901	}
2447	}	2902	}
2448		2903
2449	static void	2904	static void
2450	coro_semaphore_on_destroy (pTHX_ struct coro *coro)	2905	coro_semaphore_destroy (pTHX_ struct CoroSLF *frame)
2451	{	2906	{
2452	/* call $sem->adjust (0) to possibly wake up some other waiters */	2907	/* call $sem->adjust (0) to possibly wake up some other waiters */
2453	coro_semaphore_adjust (aTHX_ (AV *)coro->slf_frame.data, 0);	2908	coro_semaphore_adjust (aTHX_ (AV *)frame->data, 0);
2454	}	2909	}
2455		2910
2456	static int	2911	static int
2457	slf_check_semaphore_down_or_wait (pTHX_ struct CoroSLF *frame, int acquire)	2912	slf_check_semaphore_down_or_wait (pTHX_ struct CoroSLF *frame, int acquire)
2458	{	2913	{
2459	AV *av = (AV *)frame->data;	2914	AV *av = (AV *)frame->data;
2460	SV *count_sv = AvARRAY (av)[0];	2915	SV *count_sv = AvARRAY (av)[0];
		2916	SV *coro_hv = SvRV (coro_current);
2461		2917
2462	/* if we are about to throw, don't actually acquire the lock, just throw */	2918	/* if we are about to throw, don't actually acquire the lock, just throw */
2463	if (CORO_THROW)	2919	if (CORO_THROW)
2464	return 0;	2920	return 0;
2465	else if (SvIVX (count_sv) > 0)	2921	else if (SvIVX (count_sv) > 0)
2466	{	2922	{
2467	SvSTATE_current->on_destroy = 0;	2923	frame->destroy = 0;
2468		2924
2469	if (acquire)	2925	if (acquire)
2470	SvIVX (count_sv) = SvIVX (count_sv) - 1;	2926	SvIVX (count_sv) = SvIVX (count_sv) - 1;
2471	else	2927	else
2472	coro_semaphore_adjust (aTHX_ av, 0);	2928	coro_semaphore_adjust (aTHX_ av, 0);
…		…
2477	{	2933	{
2478	int i;	2934	int i;
2479	/* if we were woken up but can't down, we look through the whole */	2935	/* if we were woken up but can't down, we look through the whole */
2480	/* waiters list and only add us if we aren't in there already */	2936	/* waiters list and only add us if we aren't in there already */
2481	/* this avoids some degenerate memory usage cases */	2937	/* this avoids some degenerate memory usage cases */
2482		2938	for (i = AvFILLp (av); i > 0; --i) /* i > 0 is not an off-by-one bug */
2483	for (i = 1; i <= AvFILLp (av); ++i)
2484	if (AvARRAY (av)[i] == SvRV (coro_current))	2939	if (AvARRAY (av)[i] == coro_hv)
2485	return 1;	2940	return 1;
2486		2941
2487	av_push (av, SvREFCNT_inc (SvRV (coro_current)));	2942	av_push (av, SvREFCNT_inc (coro_hv));
2488	return 1;	2943	return 1;
2489	}	2944	}
2490	}	2945	}
2491		2946
2492	static int	2947	static int
…		…
2515	{	2970	{
2516	av_push (av, SvREFCNT_inc (SvRV (coro_current)));	2971	av_push (av, SvREFCNT_inc (SvRV (coro_current)));
2517		2972
2518	frame->data = (void *)sv_2mortal (SvREFCNT_inc ((SV *)av));	2973	frame->data = (void *)sv_2mortal (SvREFCNT_inc ((SV *)av));
2519	frame->prepare = prepare_schedule;	2974	frame->prepare = prepare_schedule;
2520
2521	/* to avoid race conditions when a woken-up coro gets terminated */	2975	/* to avoid race conditions when a woken-up coro gets terminated */
2522	/* we arrange for a temporary on_destroy that calls adjust (0) */	2976	/* we arrange for a temporary on_destroy that calls adjust (0) */
2523	SvSTATE_current->on_destroy = coro_semaphore_on_destroy;	2977	frame->destroy = coro_semaphore_destroy;
2524	}	2978	}
2525	}	2979	}
2526		2980
2527	static void	2981	static void
2528	slf_init_semaphore_down (pTHX_ struct CoroSLF *frame, CV *cv, SV **arg, int items)	2982	slf_init_semaphore_down (pTHX_ struct CoroSLF *frame, CV *cv, SV **arg, int items)
…		…
2536	{	2990	{
2537	if (items >= 2)	2991	if (items >= 2)
2538	{	2992	{
2539	/* callback form */	2993	/* callback form */
2540	AV *av = (AV *)SvRV (arg [0]);	2994	AV *av = (AV *)SvRV (arg [0]);
2541	CV *cb_cv = coro_sv_2cv (aTHX_ arg [1]);	2995	SV *cb_cv = s_get_cv_croak (arg [1]);
2542		2996
2543	av_push (av, (SV *)SvREFCNT_inc_NN (cb_cv));	2997	av_push (av, SvREFCNT_inc_NN (cb_cv));
2544		2998
2545	if (SvIVX (AvARRAY (av)[0]) > 0)	2999	if (SvIVX (AvARRAY (av)[0]) > 0)
2546	coro_semaphore_adjust (aTHX_ av, 0);	3000	coro_semaphore_adjust (aTHX_ av, 0);
2547		3001
2548	frame->prepare = prepare_nop;	3002	frame->prepare = prepare_nop;
…		…
2572	AvARRAY (av)[0] = AvARRAY (av)[1];	3026	AvARRAY (av)[0] = AvARRAY (av)[1];
2573	AvARRAY (av)[1] = cb;	3027	AvARRAY (av)[1] = cb;
2574		3028
2575	cb = av_shift (av);	3029	cb = av_shift (av);
2576		3030
		3031	if (SvTYPE (cb) == SVt_PVCV)
		3032	{
		3033	dSP;
		3034	PUSHMARK (SP);
		3035	XPUSHs (sv_2mortal (newRV_inc ((SV *)av)));
		3036	PUTBACK;
		3037	call_sv (cb, G_VOID | G_DISCARD | G_EVAL | G_KEEPERR);
		3038	}
		3039	else
		3040	{
2577	api_ready (aTHX_ cb);	3041	api_ready (aTHX_ cb);
2578	sv_setiv (cb, 0); /* signal waiter */	3042	sv_setiv (cb, 0); /* signal waiter */
		3043	}
		3044
2579	SvREFCNT_dec (cb);	3045	SvREFCNT_dec (cb);
2580		3046
2581	--count;	3047	--count;
2582	}	3048	}
2583	}	3049	}
…		…
2592	static void	3058	static void
2593	slf_init_signal_wait (pTHX_ struct CoroSLF *frame, CV *cv, SV **arg, int items)	3059	slf_init_signal_wait (pTHX_ struct CoroSLF *frame, CV *cv, SV **arg, int items)
2594	{	3060	{
2595	AV *av = (AV *)SvRV (arg [0]);	3061	AV *av = (AV *)SvRV (arg [0]);
2596		3062
		3063	if (items >= 2)
		3064	{
		3065	SV *cb_cv = s_get_cv_croak (arg [1]);
		3066	av_push (av, SvREFCNT_inc_NN (cb_cv));
		3067
2597	if (SvIVX (AvARRAY (av)[0]))	3068	if (SvIVX (AvARRAY (av)[0]))
		3069	coro_signal_wake (aTHX_ av, 1); /* must be the only waiter */
		3070
		3071	frame->prepare = prepare_nop;
		3072	frame->check = slf_check_nop;
		3073	}
		3074	else if (SvIVX (AvARRAY (av)[0]))
2598	{	3075	{
2599	SvIVX (AvARRAY (av)[0]) = 0;	3076	SvIVX (AvARRAY (av)[0]) = 0;
2600	frame->prepare = prepare_nop;	3077	frame->prepare = prepare_nop;
2601	frame->check = slf_check_nop;	3078	frame->check = slf_check_nop;
2602	}	3079	}
2603	else	3080	else
2604	{	3081	{
2605	SV *waiter = newRV_inc (SvRV (coro_current)); /* owned by signal av */	3082	SV *waiter = newSVsv (coro_current); /* owned by signal av */
2606		3083
2607	av_push (av, waiter);	3084	av_push (av, waiter);
2608		3085
2609	frame->data = (void *)sv_2mortal (SvREFCNT_inc_NN (waiter)); /* owned by process */	3086	frame->data = (void *)sv_2mortal (SvREFCNT_inc_NN (waiter)); /* owned by process */
2610	frame->prepare = prepare_schedule;	3087	frame->prepare = prepare_schedule;
…		…
2628		3105
2629	static void	3106	static void
2630	coro_aio_callback (pTHX_ CV *cv)	3107	coro_aio_callback (pTHX_ CV *cv)
2631	{	3108	{
2632	dXSARGS;	3109	dXSARGS;
2633	AV *state = (AV *)GENSUB_ARG;	3110	AV *state = (AV *)S_GENSUB_ARG;
2634	SV *coro = av_pop (state);	3111	SV *coro = av_pop (state);
2635	SV *data_sv = newSV (sizeof (struct io_state));	3112	SV *data_sv = newSV (sizeof (struct io_state));
2636		3113
2637	av_extend (state, items - 1);	3114	av_extend (state, items - 1);
2638		3115
…		…
2674	/* it quickly returns */	3151	/* it quickly returns */
2675	if (CORO_THROW)	3152	if (CORO_THROW)
2676	return 0;	3153	return 0;
2677		3154
2678	/* one element that is an RV? repeat! */	3155	/* one element that is an RV? repeat! */
2679	if (AvFILLp (state) == 0 && SvROK (AvARRAY (state)[0]))	3156	if (AvFILLp (state) == 0 && SvTYPE (AvARRAY (state)[0]) != SVt_PV)
2680	return 1;	3157	return 1;
2681		3158
2682	/* restore status */	3159	/* restore status */
2683	{	3160	{
2684	SV *data_sv = av_pop (state);	3161	SV *data_sv = av_pop (state);
…		…
2723	dSP;	3200	dSP;
2724		3201
2725	static SV *prio_cv;	3202	static SV *prio_cv;
2726	static SV *prio_sv;	3203	static SV *prio_sv;
2727		3204
2728	if (expect_false (!prio_cv))	3205	if (ecb_expect_false (!prio_cv))
2729	{	3206	{
2730	prio_cv = (SV *)get_cv ("IO::AIO::aioreq_pri", 0);	3207	prio_cv = (SV *)get_cv ("IO::AIO::aioreq_pri", 0);
2731	prio_sv = newSViv (0);	3208	prio_sv = newSViv (0);
2732	}	3209	}
2733		3210
…		…
2752		3229
2753	for (i = 0; i < items; ++i)	3230	for (i = 0; i < items; ++i)
2754	PUSHs (arg [i]);	3231	PUSHs (arg [i]);
2755		3232
2756	/* now push the callback closure */	3233	/* now push the callback closure */
2757	PUSHs (sv_2mortal (gensub (aTHX_ coro_aio_callback, (void *)SvREFCNT_inc_NN ((SV *)state))));	3234	PUSHs (sv_2mortal (s_gensub (aTHX_ coro_aio_callback, (void *)SvREFCNT_inc_NN ((SV *)state))));
2758		3235
2759	/* now call the AIO function - we assume our request is uncancelable */	3236	/* now call the AIO function - we assume our request is uncancelable */
2760	PUTBACK;	3237	PUTBACK;
2761	call_sv ((SV *)req, G_VOID | G_DISCARD);	3238	call_sv ((SV *)req, G_VOID | G_DISCARD);
2762	}	3239	}
2763		3240
2764	/* now that the requets is going, we loop toll we have a result */	3241	/* now that the request is going, we loop till we have a result */
2765	frame->data = (void *)state;	3242	frame->data = (void *)state;
2766	frame->prepare = prepare_schedule;	3243	frame->prepare = prepare_schedule;
2767	frame->check = slf_check_aio_req;	3244	frame->check = slf_check_aio_req;
2768	}	3245	}
2769		3246
…		…
2779		3256
2780	/*****************************************************************************/	3257	/*****************************************************************************/
2781		3258
2782	#if CORO_CLONE	3259	#if CORO_CLONE
2783	# include "clone.c"	3260	# include "clone.c"
		3261	#endif
		3262
		3263	/*****************************************************************************/
		3264
		3265	static SV *
		3266	coro_new (pTHX_ HV *stash, SV **argv, int argc, int is_coro)
		3267	{
		3268	SV *coro_sv;
		3269	struct coro *coro;
		3270	MAGIC *mg;
		3271	HV *hv;
		3272	SV *cb;
		3273	int i;
		3274
		3275	if (argc > 0)
		3276	{
		3277	cb = s_get_cv_croak (argv [0]);
		3278
		3279	if (!is_coro)
		3280	{
		3281	if (CvISXSUB (cb))
		3282	croak ("Coro::State doesn't support XS functions as coroutine start, caught");
		3283
		3284	if (!CvROOT (cb))
		3285	croak ("Coro::State doesn't support autoloaded or undefined functions as coroutine start, caught");
		3286	}
		3287	}
		3288
		3289	Newz (0, coro, 1, struct coro);
		3290	coro->args = newAV ();
		3291	coro->flags = CF_NEW;
		3292
		3293	if (coro_first) coro_first->prev = coro;
		3294	coro->next = coro_first;
		3295	coro_first = coro;
		3296
		3297	coro->hv = hv = newHV ();
		3298	mg = sv_magicext ((SV *)hv, 0, CORO_MAGIC_type_state, &coro_state_vtbl, (char *)coro, 0);
		3299	mg->mg_flags |= MGf_DUP;
		3300	coro_sv = sv_bless (newRV_noinc ((SV *)hv), stash);
		3301
		3302	if (argc > 0)
		3303	{
		3304	av_extend (coro->args, argc + is_coro - 1);
		3305
		3306	if (is_coro)
		3307	{
		3308	av_push (coro->args, SvREFCNT_inc_NN ((SV *)cb));
		3309	cb = (SV *)cv_coro_run;
		3310	}
		3311
		3312	coro->startcv = (CV *)SvREFCNT_inc_NN ((SV *)cb);
		3313
		3314	for (i = 1; i < argc; i++)
		3315	av_push (coro->args, newSVsv (argv [i]));
		3316	}
		3317
		3318	return coro_sv;
		3319	}
		3320
		3321	#ifndef __cplusplus
		3322	ecb_cold XS(boot_Coro__State);
		3323	#endif
		3324
		3325	#if CORO_JIT
		3326
		3327	static void ecb_noinline ecb_cold
		3328	pushav_4uv (pTHX_ UV a, UV b, UV c, UV d)
		3329	{
		3330	dSP;
		3331	AV *av = newAV ();
		3332
		3333	av_store (av, 3, newSVuv (d));
		3334	av_store (av, 2, newSVuv (c));
		3335	av_store (av, 1, newSVuv (b));
		3336	av_store (av, 0, newSVuv (a));
		3337
		3338	XPUSHs (sv_2mortal (newRV_noinc ((SV *)av)));
		3339
		3340	PUTBACK;
		3341	}
		3342
		3343	static void ecb_noinline ecb_cold
		3344	jit_init (pTHX)
		3345	{
		3346	dSP;
		3347	SV *load, *save;
		3348	char *map_base;
		3349	char *load_ptr, *save_ptr;
		3350	STRLEN load_len, save_len, map_len;
		3351	int count;
		3352
		3353	eval_pv ("require 'Coro/jit-" CORO_JIT_TYPE ".pl'", 1);
		3354
		3355	PUSHMARK (SP);
		3356	#define VARx(name,expr,type) pushav_4uv (aTHX_ (UV)&(expr), sizeof (expr), offsetof (perl_slots, name), sizeof (type));
		3357	#include "state.h"
		3358	count = call_pv ("Coro::State::_jit", G_ARRAY);
		3359	SPAGAIN;
		3360
		3361	save = POPs; save_ptr = SvPVbyte (save, save_len);
		3362	load = POPs; load_ptr = SvPVbyte (load, load_len);
		3363
		3364	map_len = load_len + save_len + 16;
		3365
		3366	map_base = mmap (0, map_len, PROT_READ | PROT_WRITE | PROT_EXEC, MAP_PRIVATE | MAP_ANONYMOUS, -1, 0);
		3367
		3368	assert (("Coro: unable to mmap jit code page, cannot continue.", map_base != (char *)MAP_FAILED));
		3369
		3370	load_perl_slots = (load_save_perl_slots_type)map_base;
		3371	memcpy (map_base, load_ptr, load_len);
		3372
		3373	map_base += (load_len + 15) & ~15;
		3374
		3375	save_perl_slots = (load_save_perl_slots_type)map_base;
		3376	memcpy (map_base, save_ptr, save_len);
		3377
		3378	/* we are good citizens and try to make the page read-only, so the evil evil */
		3379	/* hackers might have it a bit more difficult */
		3380	mprotect (map_base, map_len, PROT_READ | PROT_EXEC);
		3381
		3382	PUTBACK;
		3383	eval_pv ("undef &Coro::State::_jit", 1);
		3384	}
		3385
2784	#endif	3386	#endif
2785		3387
2786	MODULE = Coro::State PACKAGE = Coro::State PREFIX = api_	3388	MODULE = Coro::State PACKAGE = Coro::State PREFIX = api_
2787		3389
2788	PROTOTYPES: DISABLE	3390	PROTOTYPES: DISABLE
…		…
2792	#ifdef USE_ITHREADS	3394	#ifdef USE_ITHREADS
2793	# if CORO_PTHREAD	3395	# if CORO_PTHREAD
2794	coro_thx = PERL_GET_CONTEXT;	3396	coro_thx = PERL_GET_CONTEXT;
2795	# endif	3397	# endif
2796	#endif	3398	#endif
2797	BOOT_PAGESIZE;	3399	/* perl defines these to check for existance first, but why it doesn't */
		3400	/* just create them one at init time is not clear to me, except for */
		3401	/* programs trying to delete them, but... */
		3402	/* anyway, we declare this as invalid and make sure they are initialised here */
		3403	DEFSV;
		3404	ERRSV;
2798		3405
2799	cctx_current = cctx_new_empty ();	3406	cctx_current = cctx_new_empty ();
2800		3407
2801	irsgv = gv_fetchpv ("/" , GV_ADD|GV_NOTQUAL, SVt_PV);	3408	irsgv = gv_fetchpv ("/" , GV_ADD|GV_NOTQUAL, SVt_PV);
2802	stdoutgv = gv_fetchpv ("STDOUT", GV_ADD|GV_NOTQUAL, SVt_PVIO);	3409	stdoutgv = gv_fetchpv ("STDOUT", GV_ADD|GV_NOTQUAL, SVt_PVIO);
…		…
2842	coroapi.prepare_nop = prepare_nop;	3449	coroapi.prepare_nop = prepare_nop;
2843	coroapi.prepare_schedule = prepare_schedule;	3450	coroapi.prepare_schedule = prepare_schedule;
2844	coroapi.prepare_cede = prepare_cede;	3451	coroapi.prepare_cede = prepare_cede;
2845	coroapi.prepare_cede_notself = prepare_cede_notself;	3452	coroapi.prepare_cede_notself = prepare_cede_notself;
2846		3453
2847	{	3454	time_init (aTHX);
2848	SV **svp = hv_fetch (PL_modglobal, "Time::NVtime", 12, 0);
2849		3455
2850	if (!svp) croak ("Time::HiRes is required");
2851	if (!SvIOK (*svp)) croak ("Time::NVtime isn't a function pointer");
2852
2853	nvtime = INT2PTR (double (*)(), SvIV (*svp));
2854	}
2855
2856	assert (("PRIO_NORMAL must be 0", !PRIO_NORMAL));	3456	assert (("PRIO_NORMAL must be 0", !CORO_PRIO_NORMAL));
		3457	#if CORO_JIT
		3458	PUTBACK;
		3459	jit_init (aTHX);
		3460	SPAGAIN;
		3461	#endif
2857	}	3462	}
2858		3463
2859	SV *	3464	SV *
2860	new (char *klass, ...)	3465	new (SV *klass, ...)
2861	ALIAS:	3466	ALIAS:
2862	Coro::new = 1	3467	Coro::new = 1
2863	CODE:	3468	CODE:
2864	{	3469	RETVAL = coro_new (aTHX_ ix ? coro_stash : coro_state_stash, &ST (1), items - 1, ix);
2865	struct coro *coro;	3470	OUTPUT:
2866	MAGIC *mg;
2867	HV *hv;
2868	CV *cb;
2869	int i;
2870
2871	if (items > 1)
2872	{
2873	cb = coro_sv_2cv (aTHX_ ST (1));
2874
2875	if (!ix)
2876	{
2877	if (CvISXSUB (cb))
2878	croak ("Coro::State doesn't support XS functions as coroutine start, caught");
2879
2880	if (!CvROOT (cb))
2881	croak ("Coro::State doesn't support autoloaded or undefined functions as coroutine start, caught");
2882	}
2883	}
2884
2885	Newz (0, coro, 1, struct coro);
2886	coro->args = newAV ();
2887	coro->flags = CF_NEW;
2888
2889	if (coro_first) coro_first->prev = coro;
2890	coro->next = coro_first;
2891	coro_first = coro;
2892
2893	coro->hv = hv = newHV ();
2894	mg = sv_magicext ((SV *)hv, 0, CORO_MAGIC_type_state, &coro_state_vtbl, (char *)coro, 0);
2895	mg->mg_flags |= MGf_DUP;
2896	RETVAL = sv_bless (newRV_noinc ((SV *)hv), gv_stashpv (klass, 1));
2897
2898	if (items > 1)
2899	{
2900	av_extend (coro->args, items - 1 + ix - 1);
2901
2902	if (ix)
2903	{
2904	av_push (coro->args, SvREFCNT_inc_NN ((SV *)cb));
2905	cb = cv_coro_run;
2906	}
2907
2908	coro->startcv = (CV *)SvREFCNT_inc_NN ((SV *)cb);
2909
2910	for (i = 2; i < items; i++)
2911	av_push (coro->args, newSVsv (ST (i)));
2912	}
2913	}
2914	OUTPUT:
2915	RETVAL	3471	RETVAL
2916		3472
2917	void	3473	void
2918	transfer (...)	3474	transfer (...)
2919	PROTOTYPE: $$	3475	PROTOTYPE: $$
2920	CODE:	3476	CODE:
2921	CORO_EXECUTE_SLF_XS (slf_init_transfer);	3477	CORO_EXECUTE_SLF_XS (slf_init_transfer);
2922
2923	bool
2924	_destroy (SV *coro_sv)
2925	CODE:
2926	RETVAL = coro_state_destroy (aTHX_ SvSTATE (coro_sv));
2927	OUTPUT:
2928	RETVAL
2929
2930	void
2931	_exit (int code)
2932	PROTOTYPE: $
2933	CODE:
2934	_exit (code);
2935		3478
2936	SV *	3479	SV *
2937	clone (Coro::State coro)	3480	clone (Coro::State coro)
2938	CODE:	3481	CODE:
2939	{	3482	{
…		…
2994	void	3537	void
2995	list ()	3538	list ()
2996	PROTOTYPE:	3539	PROTOTYPE:
2997	PPCODE:	3540	PPCODE:
2998	{	3541	{
2999	struct coro *coro;	3542	struct coro *coro;
3000	for (coro = coro_first; coro; coro = coro->next)	3543	for (coro = coro_first; coro; coro = coro->next)
3001	if (coro->hv)	3544	if (coro->hv)
3002	XPUSHs (sv_2mortal (newRV_inc ((SV *)coro->hv)));	3545	XPUSHs (sv_2mortal (newRV_inc ((SV *)coro->hv)));
3003	}	3546	}
3004		3547
…		…
3008	eval = 1	3551	eval = 1
3009	CODE:	3552	CODE:
3010	{	3553	{
3011	if (coro->mainstack && ((coro->flags & CF_RUNNING) || coro->slot))	3554	if (coro->mainstack && ((coro->flags & CF_RUNNING) || coro->slot))
3012	{	3555	{
3013	struct coro temp;	3556	struct coro *current = SvSTATE_current;
		3557	struct CoroSLF slf_save;
3014		3558
3015	if (!(coro->flags & CF_RUNNING))	3559	if (current != coro)
3016	{	3560	{
3017	PUTBACK;	3561	PUTBACK;
3018	save_perl (aTHX_ &temp);	3562	save_perl (aTHX_ current);
3019	load_perl (aTHX_ coro);	3563	load_perl (aTHX_ coro);
		3564	/* the coro is most likely in an active SLF call.
		3565	* while not strictly required (the code we execute is
		3566	* not allowed to call any SLF functions), it's cleaner
		3567	* to reinitialise the slf_frame and restore it later.
		3568	* This might one day allow us to actually do SLF calls
		3569	* from code executed here.
		3570	*/
		3571	slf_save = slf_frame;
		3572	slf_frame.prepare = 0;
		3573	SPAGAIN;
3020	}	3574	}
3021		3575
3022	{
3023	dSP;
3024	ENTER;
3025	SAVETMPS;
3026	PUTBACK;
3027	PUSHSTACK;	3576	PUSHSTACK;
		3577
3028	PUSHMARK (SP);	3578	PUSHMARK (SP);
		3579	PUTBACK;
3029		3580
3030	if (ix)	3581	if (ix)
3031	eval_sv (coderef, 0);	3582	eval_sv (coderef, 0);
3032	else	3583	else
3033	call_sv (coderef, G_KEEPERR | G_EVAL | G_VOID | G_DISCARD);	3584	call_sv (coderef, G_KEEPERR | G_EVAL | G_VOID | G_DISCARD);
3034		3585
3035	POPSTACK;	3586	POPSTACK;
3036	SPAGAIN;	3587	SPAGAIN;
3037	FREETMPS;
3038	LEAVE;
3039	PUTBACK;
3040	}
3041		3588
3042	if (!(coro->flags & CF_RUNNING))	3589	if (current != coro)
3043	{	3590	{
		3591	PUTBACK;
		3592	slf_frame = slf_save;
3044	save_perl (aTHX_ coro);	3593	save_perl (aTHX_ coro);
3045	load_perl (aTHX_ &temp);	3594	load_perl (aTHX_ current);
3046	SPAGAIN;	3595	SPAGAIN;
3047	}	3596	}
3048	}	3597	}
3049	}	3598	}
3050		3599
…		…
3053	PROTOTYPE: $	3602	PROTOTYPE: $
3054	ALIAS:	3603	ALIAS:
3055	is_ready = CF_READY	3604	is_ready = CF_READY
3056	is_running = CF_RUNNING	3605	is_running = CF_RUNNING
3057	is_new = CF_NEW	3606	is_new = CF_NEW
3058	is_destroyed = CF_DESTROYED	3607	is_destroyed = CF_ZOMBIE
		3608	is_zombie = CF_ZOMBIE
		3609	is_suspended = CF_SUSPENDED
3059	CODE:	3610	CODE:
3060	RETVAL = boolSV (coro->flags & ix);	3611	RETVAL = boolSV (coro->flags & ix);
3061	OUTPUT:	3612	OUTPUT:
3062	RETVAL	3613	RETVAL
3063		3614
3064	void	3615	void
3065	throw (Coro::State self, SV *throw = &PL_sv_undef)	3616	throw (SV *self, SV *exception = &PL_sv_undef)
3066	PROTOTYPE: $;$	3617	PROTOTYPE: $;$
3067	CODE:	3618	CODE:
3068	{	3619	{
		3620	struct coro *coro = SvSTATE (self);
3069	struct coro *current = SvSTATE_current;	3621	struct coro *current = SvSTATE_current;
3070	SV **throwp = self == current ? &CORO_THROW : &self->except;	3622	SV **exceptionp = coro == current ? &CORO_THROW : &coro->except;
3071	SvREFCNT_dec (*throwp);	3623	SvREFCNT_dec (*exceptionp);
3072	*throwp = SvOK (throw) ? newSVsv (throw) : 0;	3624	SvGETMAGIC (exception);
		3625	*exceptionp = SvOK (exception) ? newSVsv (exception) : 0;
		3626
		3627	api_ready (aTHX_ self);
3073	}	3628	}
3074		3629
3075	void	3630	void
3076	api_trace (SV *coro, int flags = CC_TRACE | CC_TRACE_SUB)	3631	api_trace (SV *coro, int flags = CC_TRACE | CC_TRACE_SUB)
3077	PROTOTYPE: $;$	3632	PROTOTYPE: $;$
…		…
3128	SV **dst = ix ? (SV **)&self->slot->defav : (SV **)&self->slot->defsv;	3683	SV **dst = ix ? (SV **)&self->slot->defav : (SV **)&self->slot->defsv;
3129		3684
3130	SV *tmp = *src; *src = *dst; *dst = tmp;	3685	SV *tmp = *src; *src = *dst; *dst = tmp;
3131	}	3686	}
3132		3687
		3688	void
		3689	cancel (Coro::State self)
		3690	CODE:
		3691	coro_state_destroy (aTHX_ self);
		3692
		3693	SV *
		3694	enable_times (int enabled = enable_times)
		3695	CODE:
		3696	{
		3697	RETVAL = boolSV (enable_times);
		3698
		3699	if (enabled != enable_times)
		3700	{
		3701	enable_times = enabled;
		3702
		3703	coro_times_update ();
		3704	(enabled ? coro_times_sub : coro_times_add)(SvSTATE (coro_current));
		3705	}
		3706	}
		3707	OUTPUT:
		3708	RETVAL
		3709
		3710	void
		3711	times (Coro::State self)
		3712	PPCODE:
		3713	{
		3714	struct coro *current = SvSTATE (coro_current);
		3715
		3716	if (ecb_expect_false (current == self))
		3717	{
		3718	coro_times_update ();
		3719	coro_times_add (SvSTATE (coro_current));
		3720	}
		3721
		3722	EXTEND (SP, 2);
		3723	PUSHs (sv_2mortal (newSVnv (self->t_real [0] + self->t_real [1] * 1e-9)));
		3724	PUSHs (sv_2mortal (newSVnv (self->t_cpu [0] + self->t_cpu [1] * 1e-9)));
		3725
		3726	if (ecb_expect_false (current == self))
		3727	coro_times_sub (SvSTATE (coro_current));
		3728	}
		3729
		3730	void
		3731	swap_sv (Coro::State coro, SV *sv, SV *swapsv)
		3732	CODE:
		3733	{
		3734	struct coro *current = SvSTATE_current;
		3735
		3736	if (current == coro)
		3737	SWAP_SVS (current);
		3738
		3739	if (!coro->swap_sv)
		3740	coro->swap_sv = newAV ();
		3741
		3742	av_push (coro->swap_sv, SvREFCNT_inc_NN (SvRV (sv )));
		3743	av_push (coro->swap_sv, SvREFCNT_inc_NN (SvRV (swapsv)));
		3744
		3745	if (current == coro)
		3746	SWAP_SVS (current);
		3747	}
		3748
3133		3749
3134	MODULE = Coro::State PACKAGE = Coro	3750	MODULE = Coro::State PACKAGE = Coro
3135		3751
3136	BOOT:	3752	BOOT:
3137	{	3753	{
3138	int i;
3139
3140	sv_pool_rss = coro_get_sv (aTHX_ "Coro::POOL_RSS" , TRUE);	3754	sv_pool_rss = coro_get_sv (aTHX_ "Coro::POOL_RSS" , TRUE);
3141	sv_pool_size = coro_get_sv (aTHX_ "Coro::POOL_SIZE" , TRUE);	3755	sv_pool_size = coro_get_sv (aTHX_ "Coro::POOL_SIZE" , TRUE);
3142	cv_coro_run = get_cv ( "Coro::_coro_run" , GV_ADD);	3756	cv_coro_run = get_cv ( "Coro::_coro_run" , GV_ADD);
3143	cv_coro_terminate = get_cv ( "Coro::terminate" , GV_ADD);
3144	coro_current = coro_get_sv (aTHX_ "Coro::current" , FALSE); SvREADONLY_on (coro_current);	3757	coro_current = coro_get_sv (aTHX_ "Coro::current" , FALSE); SvREADONLY_on (coro_current);
3145	av_async_pool = coro_get_av (aTHX_ "Coro::async_pool", TRUE);	3758	av_async_pool = coro_get_av (aTHX_ "Coro::async_pool", TRUE);
3146	av_destroy = coro_get_av (aTHX_ "Coro::destroy" , TRUE);	3759	av_destroy = coro_get_av (aTHX_ "Coro::destroy" , TRUE);
3147	sv_manager = coro_get_sv (aTHX_ "Coro::manager" , TRUE);	3760	sv_manager = coro_get_sv (aTHX_ "Coro::manager" , TRUE);
3148	sv_idle = coro_get_sv (aTHX_ "Coro::idle" , TRUE);	3761	sv_idle = coro_get_sv (aTHX_ "Coro::idle" , TRUE);
3149		3762
3150	sv_async_pool_idle = newSVpv ("[async pool idle]", 0); SvREADONLY_on (sv_async_pool_idle);	3763	sv_async_pool_idle = newSVpv ("[async pool idle]", 0); SvREADONLY_on (sv_async_pool_idle);
3151	sv_Coro = newSVpv ("Coro", 0); SvREADONLY_on (sv_Coro);	3764	sv_Coro = newSVpv ("Coro", 0); SvREADONLY_on (sv_Coro);
3152	cv_pool_handler = get_cv ("Coro::pool_handler", GV_ADD); SvREADONLY_on (cv_pool_handler);	3765	cv_pool_handler = get_cv ("Coro::pool_handler", GV_ADD); SvREADONLY_on (cv_pool_handler);
3153	cv_coro_state_new = get_cv ("Coro::State::new", 0); SvREADONLY_on (cv_coro_state_new);	3766	CvNODEBUG_on (get_cv ("Coro::_pool_handler", 0)); /* work around a debugger bug */
3154		3767
3155	coro_stash = gv_stashpv ("Coro", TRUE);	3768	coro_stash = gv_stashpv ("Coro", TRUE);
3156		3769
3157	newCONSTSUB (coro_stash, "PRIO_MAX", newSViv (PRIO_MAX));	3770	newCONSTSUB (coro_stash, "PRIO_MAX", newSViv (CORO_PRIO_MAX));
3158	newCONSTSUB (coro_stash, "PRIO_HIGH", newSViv (PRIO_HIGH));	3771	newCONSTSUB (coro_stash, "PRIO_HIGH", newSViv (CORO_PRIO_HIGH));
3159	newCONSTSUB (coro_stash, "PRIO_NORMAL", newSViv (PRIO_NORMAL));	3772	newCONSTSUB (coro_stash, "PRIO_NORMAL", newSViv (CORO_PRIO_NORMAL));
3160	newCONSTSUB (coro_stash, "PRIO_LOW", newSViv (PRIO_LOW));	3773	newCONSTSUB (coro_stash, "PRIO_LOW", newSViv (CORO_PRIO_LOW));
3161	newCONSTSUB (coro_stash, "PRIO_IDLE", newSViv (PRIO_IDLE));	3774	newCONSTSUB (coro_stash, "PRIO_IDLE", newSViv (CORO_PRIO_IDLE));
3162	newCONSTSUB (coro_stash, "PRIO_MIN", newSViv (PRIO_MIN));	3775	newCONSTSUB (coro_stash, "PRIO_MIN", newSViv (CORO_PRIO_MIN));
3163
3164	for (i = PRIO_MAX - PRIO_MIN + 1; i--; )
3165	coro_ready[i] = newAV ();
3166		3776
3167	{	3777	{
3168	SV *sv = coro_get_sv (aTHX_ "Coro::API", TRUE);	3778	SV *sv = coro_get_sv (aTHX_ "Coro::API", TRUE);
3169		3779
3170	coroapi.schedule = api_schedule;	3780	coroapi.schedule = api_schedule;
…		…
3180	sv_setiv (sv, (IV)&coroapi);	3790	sv_setiv (sv, (IV)&coroapi);
3181	SvREADONLY_on (sv);	3791	SvREADONLY_on (sv);
3182	}	3792	}
3183	}	3793	}
3184		3794
		3795	SV *
		3796	async (...)
		3797	PROTOTYPE: &@
		3798	CODE:
		3799	RETVAL = coro_new (aTHX_ coro_stash, &ST (0), items, 1);
		3800	api_ready (aTHX_ RETVAL);
		3801	OUTPUT:
		3802	RETVAL
		3803
		3804	void
		3805	_destroy (Coro::State coro)
		3806	CODE:
		3807	/* used by the manager thread */
		3808	coro_state_destroy (aTHX_ coro);
		3809
		3810	void
		3811	on_destroy (Coro::State coro, SV *cb)
		3812	CODE:
		3813	coro_push_on_destroy (aTHX_ coro, newSVsv (cb));
		3814
		3815	void
		3816	join (...)
		3817	CODE:
		3818	CORO_EXECUTE_SLF_XS (slf_init_join);
		3819
3185	void	3820	void
3186	terminate (...)	3821	terminate (...)
3187	CODE:	3822	CODE:
3188	CORO_EXECUTE_SLF_XS (slf_init_terminate);	3823	CORO_EXECUTE_SLF_XS (slf_init_terminate);
3189		3824
3190	void	3825	void
		3826	cancel (...)
		3827	CODE:
		3828	CORO_EXECUTE_SLF_XS (slf_init_cancel);
		3829
		3830	int
		3831	safe_cancel (Coro::State self, ...)
		3832	C_ARGS: aTHX_ self, &ST (1), items - 1
		3833
		3834	void
3191	schedule (...)	3835	schedule (...)
3192	CODE:	3836	CODE:
3193	CORO_EXECUTE_SLF_XS (slf_init_schedule);	3837	CORO_EXECUTE_SLF_XS (slf_init_schedule);
3194		3838
3195	void	3839	void
…		…
3209		3853
3210	void	3854	void
3211	cede_notself (...)	3855	cede_notself (...)
3212	CODE:	3856	CODE:
3213	CORO_EXECUTE_SLF_XS (slf_init_cede_notself);	3857	CORO_EXECUTE_SLF_XS (slf_init_cede_notself);
3214
3215	void
3216	_cancel (Coro::State self)
3217	CODE:
3218	coro_state_destroy (aTHX_ self);
3219	coro_call_on_destroy (aTHX_ self);
3220		3858
3221	void	3859	void
3222	_set_current (SV *current)	3860	_set_current (SV *current)
3223	PROTOTYPE: $	3861	PROTOTYPE: $
3224	CODE:	3862	CODE:
…		…
3228	void	3866	void
3229	_set_readyhook (SV *hook)	3867	_set_readyhook (SV *hook)
3230	PROTOTYPE: $	3868	PROTOTYPE: $
3231	CODE:	3869	CODE:
3232	SvREFCNT_dec (coro_readyhook);	3870	SvREFCNT_dec (coro_readyhook);
		3871	SvGETMAGIC (hook);
		3872	if (SvOK (hook))
		3873	{
3233	coro_readyhook = SvOK (hook) ? newSVsv (hook) : 0;	3874	coro_readyhook = newSVsv (hook);
		3875	CORO_READYHOOK = invoke_sv_ready_hook_helper;
		3876	}
		3877	else
		3878	{
		3879	coro_readyhook = 0;
		3880	CORO_READYHOOK = 0;
		3881	}
3234		3882
3235	int	3883	int
3236	prio (Coro::State coro, int newprio = 0)	3884	prio (Coro::State coro, int newprio = 0)
3237	PROTOTYPE: $;$	3885	PROTOTYPE: $;$
3238	ALIAS:	3886	ALIAS:
…		…
3244	if (items > 1)	3892	if (items > 1)
3245	{	3893	{
3246	if (ix)	3894	if (ix)
3247	newprio = coro->prio - newprio;	3895	newprio = coro->prio - newprio;
3248		3896
3249	if (newprio < PRIO_MIN) newprio = PRIO_MIN;	3897	if (newprio < CORO_PRIO_MIN) newprio = CORO_PRIO_MIN;
3250	if (newprio > PRIO_MAX) newprio = PRIO_MAX;	3898	if (newprio > CORO_PRIO_MAX) newprio = CORO_PRIO_MAX;
3251		3899
3252	coro->prio = newprio;	3900	coro->prio = newprio;
3253	}	3901	}
3254	}	3902	}
3255	OUTPUT:	3903	OUTPUT:
…		…
3270	RETVAL = coro_nready;	3918	RETVAL = coro_nready;
3271	OUTPUT:	3919	OUTPUT:
3272	RETVAL	3920	RETVAL
3273		3921
3274	void	3922	void
		3923	suspend (Coro::State self)
		3924	PROTOTYPE: $
		3925	CODE:
		3926	self->flags |= CF_SUSPENDED;
		3927
		3928	void
		3929	resume (Coro::State self)
		3930	PROTOTYPE: $
		3931	CODE:
		3932	self->flags &= ~CF_SUSPENDED;
		3933
		3934	void
3275	_pool_handler (...)	3935	_pool_handler (...)
3276	CODE:	3936	CODE:
3277	CORO_EXECUTE_SLF_XS (slf_init_pool_handler);	3937	CORO_EXECUTE_SLF_XS (slf_init_pool_handler);
3278		3938
3279	void	3939	void
…		…
3290	for (i = 1; i < items; ++i)	3950	for (i = 1; i < items; ++i)
3291	av_push (av, SvREFCNT_inc_NN (ST (i)));	3951	av_push (av, SvREFCNT_inc_NN (ST (i)));
3292		3952
3293	if ((SV *)hv == &PL_sv_undef)	3953	if ((SV *)hv == &PL_sv_undef)
3294	{	3954	{
3295	PUSHMARK (SP);	3955	SV *sv = coro_new (aTHX_ coro_stash, (SV **)&cv_pool_handler, 1, 1);
3296	EXTEND (SP, 2);
3297	PUSHs (sv_Coro);
3298	PUSHs ((SV *)cv_pool_handler);
3299	PUTBACK;
3300	call_sv ((SV *)cv_coro_state_new, G_SCALAR);
3301	SPAGAIN;
3302
3303	hv = (HV *)SvREFCNT_inc_NN (SvRV (POPs));	3956	hv = (HV *)SvREFCNT_inc_NN (SvRV (sv));
		3957	SvREFCNT_dec (sv);
3304	}	3958	}
3305		3959
3306	{	3960	{
3307	struct coro *coro = SvSTATE_hv (hv);	3961	struct coro *coro = SvSTATE_hv (hv);
3308		3962
…		…
3332	rouse_wait (...)	3986	rouse_wait (...)
3333	PROTOTYPE: ;$	3987	PROTOTYPE: ;$
3334	PPCODE:	3988	PPCODE:
3335	CORO_EXECUTE_SLF_XS (slf_init_rouse_wait);	3989	CORO_EXECUTE_SLF_XS (slf_init_rouse_wait);
3336		3990
		3991	void
		3992	on_enter (SV *block)
		3993	ALIAS:
		3994	on_leave = 1
		3995	PROTOTYPE: &
		3996	CODE:
		3997	{
		3998	struct coro *coro = SvSTATE_current;
		3999	AV **avp = ix ? &coro->on_leave : &coro->on_enter;
		4000
		4001	block = s_get_cv_croak (block);
		4002
		4003	if (!*avp)
		4004	*avp = newAV ();
		4005
		4006	av_push (*avp, SvREFCNT_inc (block));
		4007
		4008	if (!ix)
		4009	on_enterleave_call (aTHX_ block);
		4010
		4011	LEAVE; /* pp_entersub unfortunately forces an ENTER/LEAVE around XS calls */
		4012	SAVEDESTRUCTOR_X (ix ? coro_pop_on_leave : coro_pop_on_enter, (void *)coro);
		4013	ENTER; /* pp_entersub unfortunately forces an ENTER/LEAVE around XS calls */
		4014	}
		4015
3337		4016
3338	MODULE = Coro::State PACKAGE = PerlIO::cede	4017	MODULE = Coro::State PACKAGE = PerlIO::cede
3339		4018
3340	BOOT:	4019	BOOT:
3341	PerlIO_define_layer (aTHX_ &PerlIO_cede);	4020	PerlIO_define_layer (aTHX_ &PerlIO_cede);
…		…
3344	MODULE = Coro::State PACKAGE = Coro::Semaphore	4023	MODULE = Coro::State PACKAGE = Coro::Semaphore
3345		4024
3346	SV *	4025	SV *
3347	new (SV *klass, SV *count = 0)	4026	new (SV *klass, SV *count = 0)
3348	CODE:	4027	CODE:
		4028	{
		4029	int semcnt = 1;
		4030
		4031	if (count)
		4032	{
		4033	SvGETMAGIC (count);
		4034
		4035	if (SvOK (count))
		4036	semcnt = SvIV (count);
		4037	}
		4038
3349	RETVAL = sv_bless (	4039	RETVAL = sv_bless (
3350	coro_waitarray_new (aTHX_ count && SvOK (count) ? SvIV (count) : 1),	4040	coro_waitarray_new (aTHX_ semcnt),
3351	GvSTASH (CvGV (cv))	4041	GvSTASH (CvGV (cv))
3352	);	4042	);
		4043	}
3353	OUTPUT:	4044	OUTPUT:
3354	RETVAL	4045	RETVAL
3355		4046
3356	# helper for Coro::Channel	4047	# helper for Coro::Channel and others
3357	SV *	4048	SV *
3358	_alloc (int count)	4049	_alloc (int count)
3359	CODE:	4050	CODE:
3360	RETVAL = coro_waitarray_new (aTHX_ count);	4051	RETVAL = coro_waitarray_new (aTHX_ count);
3361	OUTPUT:	4052	OUTPUT:
…		…
3403	XSRETURN_NO;	4094	XSRETURN_NO;
3404	}	4095	}
3405		4096
3406	void	4097	void
3407	waiters (SV *self)	4098	waiters (SV *self)
3408	PPCODE:	4099	PPCODE:
3409	{	4100	{
3410	AV *av = (AV *)SvRV (self);	4101	AV *av = (AV *)SvRV (self);
3411	int wcount = AvFILLp (av) + 1 - 1;	4102	int wcount = AvFILLp (av) + 1 - 1;
3412		4103
3413	if (GIMME_V == G_SCALAR)	4104	if (GIMME_V == G_SCALAR)
…		…
3419	for (i = 1; i <= wcount; ++i)	4110	for (i = 1; i <= wcount; ++i)
3420	PUSHs (sv_2mortal (newRV_inc (AvARRAY (av)[i])));	4111	PUSHs (sv_2mortal (newRV_inc (AvARRAY (av)[i])));
3421	}	4112	}
3422	}	4113	}
3423		4114
		4115	MODULE = Coro::State PACKAGE = Coro::SemaphoreSet
		4116
		4117	void
		4118	_may_delete (SV *sem, int count, unsigned int extra_refs)
		4119	PPCODE:
		4120	{
		4121	AV *av = (AV *)SvRV (sem);
		4122
		4123	if (SvREFCNT ((SV *)av) == 1 + extra_refs
		4124	&& AvFILLp (av) == 0 /* no waiters, just count */
		4125	&& SvIV (AvARRAY (av)[0]) == count)
		4126	XSRETURN_YES;
		4127
		4128	XSRETURN_NO;
		4129	}
		4130
3424	MODULE = Coro::State PACKAGE = Coro::Signal	4131	MODULE = Coro::State PACKAGE = Coro::Signal
3425		4132
3426	SV *	4133	SV *
3427	new (SV *klass)	4134	new (SV *klass)
3428	CODE:	4135	CODE:
…		…
3440		4147
3441	void	4148	void
3442	broadcast (SV *self)	4149	broadcast (SV *self)
3443	CODE:	4150	CODE:
3444	{	4151	{
3445	AV *av = (AV *)SvRV (self);	4152	AV *av = (AV *)SvRV (self);
3446	coro_signal_wake (aTHX_ av, AvFILLp (av));	4153	coro_signal_wake (aTHX_ av, AvFILLp (av));
3447	}	4154	}
3448		4155
3449	void	4156	void
3450	send (SV *self)	4157	send (SV *self)
…		…
3458	SvIVX (AvARRAY (av)[0]) = 1; /* remember the signal */	4165	SvIVX (AvARRAY (av)[0]) = 1; /* remember the signal */
3459	}	4166	}
3460		4167
3461	IV	4168	IV
3462	awaited (SV *self)	4169	awaited (SV *self)
3463	CODE:	4170	CODE:
3464	RETVAL = AvFILLp ((AV *)SvRV (self)) + 1 - 1;	4171	RETVAL = AvFILLp ((AV *)SvRV (self)) + 1 - 1;
3465	OUTPUT:	4172	OUTPUT:
3466	RETVAL	4173	RETVAL
3467		4174
3468		4175
…		…
3473		4180
3474	void	4181	void
3475	_schedule (...)	4182	_schedule (...)
3476	CODE:	4183	CODE:
3477	{	4184	{
3478	static int incede;	4185	static int incede;
3479		4186
3480	api_cede_notself (aTHX);	4187	api_cede_notself (aTHX);
3481		4188
3482	++incede;	4189	++incede;
3483	while (coro_nready >= incede && api_cede (aTHX))	4190	while (coro_nready >= incede && api_cede (aTHX))
…		…
3499		4206
3500	void	4207	void
3501	_register (char *target, char *proto, SV *req)	4208	_register (char *target, char *proto, SV *req)
3502	CODE:	4209	CODE:
3503	{	4210	{
3504	CV *req_cv = coro_sv_2cv (aTHX_ req);	4211	SV *req_cv = s_get_cv_croak (req);
3505	/* newXSproto doesn't return the CV on 5.8 */	4212	/* newXSproto doesn't return the CV on 5.8 */
3506	CV *slf_cv = newXS (target, coro_aio_req_xs, __FILE__);	4213	CV *slf_cv = newXS (target, coro_aio_req_xs, __FILE__);
3507	sv_setpv ((SV *)slf_cv, proto);	4214	sv_setpv ((SV *)slf_cv, proto);
3508	sv_magicext ((SV *)slf_cv, (SV *)req_cv, CORO_MAGIC_type_aio, 0, 0, 0);	4215	sv_magicext ((SV *)slf_cv, (SV *)req_cv, CORO_MAGIC_type_aio, 0, 0, 0);
3509	}	4216	}
3510		4217
		4218	MODULE = Coro::State PACKAGE = Coro::Select
		4219
		4220	void
		4221	patch_pp_sselect ()
		4222	CODE:
		4223	if (!coro_old_pp_sselect)
		4224	{
		4225	coro_select_select = (SV *)get_cv ("Coro::Select::select", 0);
		4226	coro_old_pp_sselect = PL_ppaddr [OP_SSELECT];
		4227	PL_ppaddr [OP_SSELECT] = coro_pp_sselect;
		4228	}
		4229
		4230	void
		4231	unpatch_pp_sselect ()
		4232	CODE:
		4233	if (coro_old_pp_sselect)
		4234	{
		4235	PL_ppaddr [OP_SSELECT] = coro_old_pp_sselect;
		4236	coro_old_pp_sselect = 0;
		4237	}
		4238
		4239	MODULE = Coro::State PACKAGE = Coro::Util
		4240
		4241	void
		4242	_exit (int code)
		4243	CODE:
		4244	_exit (code);
		4245
		4246	NV
		4247	time ()
		4248	CODE:
		4249	RETVAL = nvtime (aTHX);
		4250	OUTPUT:
		4251	RETVAL
		4252
		4253	NV
		4254	gettimeofday ()
		4255	PPCODE:
		4256	{
		4257	UV tv [2];
		4258	u2time (aTHX_ tv);
		4259	EXTEND (SP, 2);
		4260	PUSHs (sv_2mortal (newSVuv (tv [0])));
		4261	PUSHs (sv_2mortal (newSVuv (tv [1])));
		4262	}
		4263

Diff Legend

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