ViewVC Help

View File | Revision Log | Show Annotations | Download File

/cvs/Coro/Coro/State.xs

Comparing Coro/Coro/State.xs (file contents):
Revision 1.339 by root, Mon Dec 15 00:28:30 2008 UTC vs.
Revision 1.443 by root, Thu Mar 6 06:40:32 2014 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	#define ECB_NO_LIBM 1
		20	#include "ecb.h"
		21
		22	#include <stddef.h>
13	#include <stdio.h>	23	#include <stdio.h>
14	#include <errno.h>	24	#include <errno.h>
15	#include <assert.h>	25	#include <assert.h>
16		26
17	#ifdef WIN32	27	#ifndef SVs_PADSTALE
		28	# define SVs_PADSTALE 0
		29	#endif
		30
		31	#ifdef PadARRAY
		32	# define NEWPADAPI 1
		33	# define newPADLIST(var) (Newz (0, var, 1, PADLIST), Newx (PadlistARRAY (var), 2, PAD *))
		34	#else
		35	typedef AV PADNAMELIST;
		36	# if !PERL_VERSION_ATLEAST(5,8,0)
		37	typedef AV PADLIST;
		38	typedef AV PAD;
		39	# endif
		40	# define PadlistARRAY(pl) ((PAD **)AvARRAY (pl))
		41	# define PadlistMAX(pl) AvFILLp (pl)
		42	# define PadlistNAMES(pl) (*PadlistARRAY (pl))
		43	# define PadARRAY AvARRAY
		44	# define PadMAX AvFILLp
		45	# define newPADLIST(var) ((var) = newAV (), av_extend (var, 1))
		46	#endif
		47
		48	/* 5.19.something has replaced SVt_BIND by SVt_INVLIST */
		49	/* we just alias it to SVt_IV, as that is sufficient for swap_sv for now */
		50	#if PERL_VERSION_ATLEAST(5,19,0)
		51	# define SVt_BIND SVt_IV
		52	#endif
		53
		54	#if defined(_WIN32)
		55	# undef HAS_GETTIMEOFDAY
18	# undef setjmp	56	# undef setjmp
19	# undef longjmp	57	# undef longjmp
20	# undef _exit	58	# undef _exit
21	# define setjmp _setjmp /* deep magic */	59	# define setjmp _setjmp /* deep magic */
22	#else	60	#else
23	# include <inttypes.h> /* most portable stdint.h */	61	# include <inttypes.h> /* most portable stdint.h */
24	#endif	62	#endif
25		63
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 */	64	/* the maximum number of idle cctx that will be pooled */
54	static int cctx_max_idle = 4;	65	static int cctx_max_idle = 4;
55		66
56	#define PERL_VERSION_ATLEAST(a,b,c) \	67	#if defined(DEBUGGING) && PERL_VERSION_ATLEAST(5,12,0)
57	(PERL_REVISION > (a) \	68	# 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	69	#endif
122		70
123	/* prefer perl internal functions over our own? */	71	/* prefer perl internal functions over our own? */
124	#ifndef CORO_PREFER_PERL_FUNCTIONS	72	#ifndef CORO_PREFER_PERL_FUNCTIONS
125	# define CORO_PREFER_PERL_FUNCTIONS 0	73	# define CORO_PREFER_PERL_FUNCTIONS 0
…		…
135	# define STACKLEVEL ((void *)&stacklevel)	83	# define STACKLEVEL ((void *)&stacklevel)
136	#endif	84	#endif
137		85
138	#define IN_DESTRUCT PL_dirty	86	#define IN_DESTRUCT PL_dirty
139		87
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"	88	#include "CoroAPI.h"
156	#define GCoroAPI (&coroapi) /* very sneaky */	89	#define GCoroAPI (&coroapi) /* very sneaky */
157		90
158	#ifdef USE_ITHREADS	91	#ifdef USE_ITHREADS
159	# if CORO_PTHREAD	92	# if CORO_PTHREAD
160	static void *coro_thx;	93	static void *coro_thx;
161	# endif	94	# endif
162	#endif	95	#endif
163		96
		97	#ifdef __linux
		98	# include <time.h> /* for timespec */
		99	# include <syscall.h> /* for SYS_* */
		100	# ifdef SYS_clock_gettime
		101	# define coro_clock_gettime(id, ts) syscall (SYS_clock_gettime, (id), (ts))
		102	# define CORO_CLOCK_MONOTONIC 1
		103	# define CORO_CLOCK_THREAD_CPUTIME_ID 3
		104	# endif
		105	#endif
		106
164	static double (*nvtime)(); /* so why doesn't it take void? */	107	static double (*nvtime)(); /* so why doesn't it take void? */
		108	static void (*u2time)(pTHX_ UV ret[2]);
165		109
166	/* we hijack an hopefully unused CV flag for our purposes */	110	/* we hijack an hopefully unused CV flag for our purposes */
167	#define CVf_SLF 0x4000	111	#define CVf_SLF 0x4000
168	static OP *pp_slf (pTHX);	112	static OP *pp_slf (pTHX);
		113	static void slf_destroy (pTHX_ struct coro *coro);
169		114
170	static U32 cctx_gen;	115	static U32 cctx_gen;
171	static size_t cctx_stacksize = CORO_STACKSIZE;	116	static size_t cctx_stacksize = CORO_STACKSIZE;
172	static struct CoroAPI coroapi;	117	static struct CoroAPI coroapi;
173	static AV *main_mainstack; /* used to differentiate between $main and others */	118	static AV *main_mainstack; /* used to differentiate between $main and others */
…		…
190	static SV *sv_pool_size;	135	static SV *sv_pool_size;
191	static SV *sv_async_pool_idle; /* description string */	136	static SV *sv_async_pool_idle; /* description string */
192	static AV *av_async_pool; /* idle pool */	137	static AV *av_async_pool; /* idle pool */
193	static SV *sv_Coro; /* class string */	138	static SV *sv_Coro; /* class string */
194	static CV *cv_pool_handler;	139	static CV *cv_pool_handler;
195	static CV *cv_coro_state_new;
196		140
197	/* Coro::AnyEvent */	141	/* Coro::AnyEvent */
198	static SV *sv_activity;	142	static SV *sv_activity;
199		143
		144	/* enable processtime/realtime profiling */
		145	static char enable_times;
		146	typedef U32 coro_ts[2];
		147	static coro_ts time_real, time_cpu;
		148	static char times_valid;
		149
200	static struct coro_cctx *cctx_first;	150	static struct coro_cctx *cctx_first;
201	static int cctx_count, cctx_idle;	151	static int cctx_count, cctx_idle;
202		152
203	enum {	153	enum
		154	{
204	CC_MAPPED = 0x01,	155	CC_MAPPED = 0x01,
205	CC_NOREUSE = 0x02, /* throw this away after tracing */	156	CC_NOREUSE = 0x02, /* throw this away after tracing */
206	CC_TRACE = 0x04,	157	CC_TRACE = 0x04,
207	CC_TRACE_SUB = 0x08, /* trace sub calls */	158	CC_TRACE_SUB = 0x08, /* trace sub calls */
208	CC_TRACE_LINE = 0x10, /* trace each statement */	159	CC_TRACE_LINE = 0x10, /* trace each statement */
…		…
213	typedef struct coro_cctx	164	typedef struct coro_cctx
214	{	165	{
215	struct coro_cctx *next;	166	struct coro_cctx *next;
216		167
217	/* the stack */	168	/* the stack */
218	void *sptr;	169	struct coro_stack stack;
219	size_t ssize;
220		170
221	/* cpu state */	171	/* cpu state */
222	void *idle_sp; /* sp of top-level transfer/schedule/cede call */	172	void *idle_sp; /* sp of top-level transfer/schedule/cede call */
		173	#ifndef NDEBUG
223	JMPENV *idle_te; /* same as idle_sp, but for top_env, TODO: remove once stable */	174	JMPENV *idle_te; /* same as idle_sp, but for top_env */
		175	#endif
224	JMPENV *top_env;	176	JMPENV *top_env;
225	coro_context cctx;	177	coro_context cctx;
226		178
227	U32 gen;	179	U32 gen;
228	#if CORO_USE_VALGRIND	180	#if CORO_USE_VALGRIND
229	int valgrind_id;	181	int valgrind_id;
230	#endif	182	#endif
231	unsigned char flags;	183	unsigned char flags;
232	} coro_cctx;	184	} coro_cctx;
233		185
234	coro_cctx *cctx_current; /* the currently running cctx */	186	static coro_cctx *cctx_current; /* the currently running cctx */
235		187
236	/*****************************************************************************/	188	/*****************************************************************************/
237		189
		190	static MGVTBL coro_state_vtbl;
		191
238	enum {	192	enum
		193	{
239	CF_RUNNING = 0x0001, /* coroutine is running */	194	CF_RUNNING = 0x0001, /* coroutine is running */
240	CF_READY = 0x0002, /* coroutine is ready */	195	CF_READY = 0x0002, /* coroutine is ready */
241	CF_NEW = 0x0004, /* has never been switched to */	196	CF_NEW = 0x0004, /* has never been switched to */
242	CF_DESTROYED = 0x0008, /* coroutine data has been freed */	197	CF_ZOMBIE = 0x0008, /* coroutine data has been freed */
		198	CF_SUSPENDED = 0x0010, /* coroutine can't be scheduled */
		199	CF_NOCANCEL = 0x0020, /* cannot cancel, set slf_frame.data to 1 (hackish) */
243	};	200	};
244		201
245	/* the structure where most of the perl state is stored, overlaid on the cxstack */	202	/* the structure where most of the perl state is stored, overlaid on the cxstack */
246	typedef struct	203	typedef struct
247	{	204	{
248	SV *defsv;
249	AV *defav;
250	SV *errsv;
251	SV *irsgv;
252	HV *hinthv;
253	#define VAR(name,type) type name;	205	#define VARx(name,expr,type) type name;
254	# include "state.h"	206	#include "state.h"
255	#undef VAR
256	} perl_slots;	207	} perl_slots;
257		208
		209	/* 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))	210	#define SLOT_COUNT ((sizeof (perl_slots) + sizeof (PERL_CONTEXT) - 1) / sizeof (PERL_CONTEXT))
259		211
260	/* this is a structure representing a perl-level coroutine */	212	/* this is a structure representing a perl-level coroutine */
261	struct coro {	213	struct coro
		214	{
262	/* the C coroutine allocated to this perl coroutine, if any */	215	/* the C coroutine allocated to this perl coroutine, if any */
263	coro_cctx *cctx;	216	coro_cctx *cctx;
		217
		218	/* ready queue */
		219	struct coro *next_ready;
264		220
265	/* state data */	221	/* state data */
266	struct CoroSLF slf_frame; /* saved slf frame */	222	struct CoroSLF slf_frame; /* saved slf frame */
267	AV *mainstack;	223	AV *mainstack;
268	perl_slots *slot; /* basically the saved sp */	224	perl_slots *slot; /* basically the saved sp */
269		225
270	CV *startcv; /* the CV to execute */	226	CV *startcv; /* the CV to execute */
271	AV *args; /* data associated with this coroutine (initial args) */	227	AV *args; /* data associated with this coroutine (initial args) */
272	int refcnt; /* coroutines are refcounted, yes */
273	int flags; /* CF_ flags */	228	int flags; /* CF_ flags */
274	HV *hv; /* the perl hash associated with this coro, if any */	229	HV *hv; /* the perl hash associated with this coro, if any */
275	void (*on_destroy)(pTHX_ struct coro *coro);
276		230
277	/* statistics */	231	/* statistics */
278	int usecount; /* number of transfers to this coro */	232	int usecount; /* number of transfers to this coro */
279		233
280	/* coro process data */	234	/* coro process data */
281	int prio;	235	int prio;
282	SV *except; /* exception to be thrown */	236	SV *except; /* exception to be thrown */
283	SV *rouse_cb;	237	SV *rouse_cb; /* last rouse callback */
		238	AV *on_destroy; /* callbacks or coros to notify on destroy */
		239	AV *status; /* the exit status list */
284		240
285	/* async_pool */	241	/* async_pool */
286	SV *saved_deffh;	242	SV *saved_deffh;
287	SV *invoke_cb;	243	SV *invoke_cb;
288	AV *invoke_av;	244	AV *invoke_av;
289		245
290	/* on_enter/on_leave */	246	/* on_enter/on_leave */
291	AV *on_enter;	247	AV *on_enter;
292	AV *on_leave;	248	AV *on_leave;
293		249
		250	/* swap_sv */
		251	AV *swap_sv;
		252
		253	/* times */
		254	coro_ts t_cpu, t_real;
		255
294	/* linked list */	256	/* linked list */
295	struct coro *next, *prev;	257	struct coro *next, *prev;
296	};	258	};
297		259
298	typedef struct coro *Coro__State;	260	typedef struct coro *Coro__State;
299	typedef struct coro *Coro__State_or_hashref;	261	typedef struct coro *Coro__State_or_hashref;
300		262
301	/* the following variables are effectively part of the perl context */	263	/* the following variables are effectively part of the perl context */
302	/* and get copied between struct coro and these variables */	264	/* and get copied between struct coro and these variables */
303	/* the mainr easonw e don't support windows process emulation */	265	/* the main reason we don't support windows process emulation */
304	static struct CoroSLF slf_frame; /* the current slf frame */	266	static struct CoroSLF slf_frame; /* the current slf frame */
305		267
306	/** Coro ********************************************************************/	268	/** Coro ********************************************************************/
307		269
308	#define PRIO_MAX 3	270	#define CORO_PRIO_MAX 3
309	#define PRIO_HIGH 1	271	#define CORO_PRIO_HIGH 1
310	#define PRIO_NORMAL 0	272	#define CORO_PRIO_NORMAL 0
311	#define PRIO_LOW -1	273	#define CORO_PRIO_LOW -1
312	#define PRIO_IDLE -3	274	#define CORO_PRIO_IDLE -3
313	#define PRIO_MIN -4	275	#define CORO_PRIO_MIN -4
314		276
315	/* for Coro.pm */	277	/* for Coro.pm */
316	static SV *coro_current;	278	static SV *coro_current;
317	static SV *coro_readyhook;	279	static SV *coro_readyhook;
318	static AV *coro_ready [PRIO_MAX - PRIO_MIN + 1];	280	static struct coro *coro_ready [CORO_PRIO_MAX - CORO_PRIO_MIN + 1][2]; /* head|tail */
319	static CV *cv_coro_run, *cv_coro_terminate;	281	static CV *cv_coro_run;
320	static struct coro *coro_first;	282	static struct coro *coro_first;
321	#define coro_nready coroapi.nready	283	#define coro_nready coroapi.nready
322		284
		285	/** JIT *********************************************************************/
		286
		287	#if CORO_JIT
		288	/* APPLE doesn't have mmap though */
		289	#define CORO_JIT_UNIXY (__linux || __FreeBSD__ || __OpenBSD__ || __NetBSD__ || __solaris || __APPLE__)
		290	#ifndef CORO_JIT_TYPE
		291	#if ECB_AMD64 && CORO_JIT_UNIXY
		292	#define CORO_JIT_TYPE "amd64-unix"
		293	#elif __i386 && CORO_JIT_UNIXY
		294	#define CORO_JIT_TYPE "x86-unix"
		295	#endif
		296	#endif
		297	#endif
		298
		299	#if !defined(CORO_JIT_TYPE) || _POSIX_MEMORY_PROTECTION <= 0
		300	#undef CORO_JIT
		301	#endif
		302
		303	#if CORO_JIT
		304	typedef void (*load_save_perl_slots_type)(perl_slots *);
		305	static load_save_perl_slots_type load_perl_slots, save_perl_slots;
		306	#endif
		307
		308	/** Coro::Select ************************************************************/
		309
		310	static OP *(*coro_old_pp_sselect) (pTHX);
		311	static SV *coro_select_select;
		312
		313	/* horrible hack, but if it works... */
		314	static OP *
		315	coro_pp_sselect (pTHX)
		316	{
		317	dSP;
		318	PUSHMARK (SP - 4); /* fake argument list */
		319	XPUSHs (coro_select_select);
		320	PUTBACK;
		321
		322	/* entersub is an UNOP, select a LISTOP... keep your fingers crossed */
		323	PL_op->op_flags |= OPf_STACKED;
		324	PL_op->op_private = 0;
		325	return PL_ppaddr [OP_ENTERSUB](aTHX);
		326	}
		327
		328	/** time stuff **************************************************************/
		329
		330	#ifdef HAS_GETTIMEOFDAY
		331
		332	ecb_inline void
		333	coro_u2time (pTHX_ UV ret[2])
		334	{
		335	struct timeval tv;
		336	gettimeofday (&tv, 0);
		337
		338	ret [0] = tv.tv_sec;
		339	ret [1] = tv.tv_usec;
		340	}
		341
		342	ecb_inline double
		343	coro_nvtime (void)
		344	{
		345	struct timeval tv;
		346	gettimeofday (&tv, 0);
		347
		348	return tv.tv_sec + tv.tv_usec * 1e-6;
		349	}
		350
		351	ecb_inline void
		352	time_init (pTHX)
		353	{
		354	nvtime = coro_nvtime;
		355	u2time = coro_u2time;
		356	}
		357
		358	#else
		359
		360	ecb_inline void
		361	time_init (pTHX)
		362	{
		363	SV **svp;
		364
		365	require_pv ("Time/HiRes.pm");
		366
		367	svp = hv_fetch (PL_modglobal, "Time::NVtime", 12, 0);
		368
		369	if (!svp) croak ("Time::HiRes is required, but missing. Caught");
		370	if (!SvIOK (*svp)) croak ("Time::NVtime isn't a function pointer. Caught");
		371
		372	nvtime = INT2PTR (double (*)(), SvIV (*svp));
		373
		374	svp = hv_fetch (PL_modglobal, "Time::U2time", 12, 0);
		375	u2time = INT2PTR (void (*)(pTHX_ UV ret[2]), SvIV (*svp));
		376	}
		377
		378	#endif
		379
323	/** lowlevel stuff **********************************************************/	380	/** lowlevel stuff **********************************************************/
324		381
325	static SV *	382	static SV * ecb_noinline
326	coro_get_sv (pTHX_ const char *name, int create)	383	coro_get_sv (pTHX_ const char *name, int create)
327	{	384	{
328	#if PERL_VERSION_ATLEAST (5,10,0)	385	#if PERL_VERSION_ATLEAST (5,10,0)
329	/* silence stupid and wrong 5.10 warning that I am unable to switch off */	386	/* silence stupid and wrong 5.10 warning that I am unable to switch off */
330	get_sv (name, create);	387	get_sv (name, create);
331	#endif	388	#endif
332	return get_sv (name, create);	389	return get_sv (name, create);
333	}	390	}
334		391
335	static AV *	392	static AV * ecb_noinline
336	coro_get_av (pTHX_ const char *name, int create)	393	coro_get_av (pTHX_ const char *name, int create)
337	{	394	{
338	#if PERL_VERSION_ATLEAST (5,10,0)	395	#if PERL_VERSION_ATLEAST (5,10,0)
339	/* silence stupid and wrong 5.10 warning that I am unable to switch off */	396	/* silence stupid and wrong 5.10 warning that I am unable to switch off */
340	get_av (name, create);	397	get_av (name, create);
341	#endif	398	#endif
342	return get_av (name, create);	399	return get_av (name, create);
343	}	400	}
344		401
345	static HV *	402	static HV * ecb_noinline
346	coro_get_hv (pTHX_ const char *name, int create)	403	coro_get_hv (pTHX_ const char *name, int create)
347	{	404	{
348	#if PERL_VERSION_ATLEAST (5,10,0)	405	#if PERL_VERSION_ATLEAST (5,10,0)
349	/* silence stupid and wrong 5.10 warning that I am unable to switch off */	406	/* silence stupid and wrong 5.10 warning that I am unable to switch off */
350	get_hv (name, create);	407	get_hv (name, create);
351	#endif	408	#endif
352	return get_hv (name, create);	409	return get_hv (name, create);
353	}	410	}
354		411
355	/* may croak */	412	ecb_inline void
356	INLINE CV *	413	coro_times_update (void)
357	coro_sv_2cv (pTHX_ SV *sv)
358	{	414	{
359	HV *st;	415	#ifdef coro_clock_gettime
360	GV *gvp;	416	struct timespec ts;
361	CV *cv = sv_2cv (sv, &st, &gvp, 0);
362		417
363	if (!cv)	418	ts.tv_sec = ts.tv_nsec = 0;
364	croak ("code reference expected");	419	coro_clock_gettime (CORO_CLOCK_THREAD_CPUTIME_ID, &ts);
		420	time_cpu [0] = ts.tv_sec; time_cpu [1] = ts.tv_nsec;
365		421
366	return cv;	422	ts.tv_sec = ts.tv_nsec = 0;
		423	coro_clock_gettime (CORO_CLOCK_MONOTONIC, &ts);
		424	time_real [0] = ts.tv_sec; time_real [1] = ts.tv_nsec;
		425	#else
		426	dTHX;
		427	UV tv[2];
		428
		429	u2time (aTHX_ tv);
		430	time_real [0] = tv [0];
		431	time_real [1] = tv [1] * 1000;
		432	#endif
		433	}
		434
		435	ecb_inline void
		436	coro_times_add (struct coro *c)
		437	{
		438	c->t_real [1] += time_real [1];
		439	if (c->t_real [1] > 1000000000) { c->t_real [1] -= 1000000000; ++c->t_real [0]; }
		440	c->t_real [0] += time_real [0];
		441
		442	c->t_cpu [1] += time_cpu [1];
		443	if (c->t_cpu [1] > 1000000000) { c->t_cpu [1] -= 1000000000; ++c->t_cpu [0]; }
		444	c->t_cpu [0] += time_cpu [0];
		445	}
		446
		447	ecb_inline void
		448	coro_times_sub (struct coro *c)
		449	{
		450	if (c->t_real [1] < time_real [1]) { c->t_real [1] += 1000000000; --c->t_real [0]; }
		451	c->t_real [1] -= time_real [1];
		452	c->t_real [0] -= time_real [0];
		453
		454	if (c->t_cpu [1] < time_cpu [1]) { c->t_cpu [1] += 1000000000; --c->t_cpu [0]; }
		455	c->t_cpu [1] -= time_cpu [1];
		456	c->t_cpu [0] -= time_cpu [0];
367	}	457	}
368		458
369	/*****************************************************************************/	459	/*****************************************************************************/
370	/* magic glue */	460	/* magic glue */
371		461
372	#define CORO_MAGIC_type_cv 26	462	#define CORO_MAGIC_type_cv 26
373	#define CORO_MAGIC_type_state PERL_MAGIC_ext	463	#define CORO_MAGIC_type_state PERL_MAGIC_ext
374		464
375	#define CORO_MAGIC_NN(sv, type) \	465	#define CORO_MAGIC_NN(sv, type) \
376	(expect_true (SvMAGIC (sv)->mg_type == type) \	466	(ecb_expect_true (SvMAGIC (sv)->mg_type == type) \
377	? SvMAGIC (sv) \	467	? SvMAGIC (sv) \
378	: mg_find (sv, type))	468	: mg_find (sv, type))
379		469
380	#define CORO_MAGIC(sv, type) \	470	#define CORO_MAGIC(sv, type) \
381	(expect_true (SvMAGIC (sv)) \	471	(ecb_expect_true (SvMAGIC (sv)) \
382	? CORO_MAGIC_NN (sv, type) \	472	? CORO_MAGIC_NN (sv, type) \
383	: 0)	473	: 0)
384		474
385	#define CORO_MAGIC_cv(cv) CORO_MAGIC (((SV *)(cv)), CORO_MAGIC_type_cv)	475	#define CORO_MAGIC_cv(cv) CORO_MAGIC (((SV *)(cv)), CORO_MAGIC_type_cv)
386	#define CORO_MAGIC_state(sv) CORO_MAGIC_NN (((SV *)(sv)), CORO_MAGIC_type_state)	476	#define CORO_MAGIC_state(sv) CORO_MAGIC_NN (((SV *)(sv)), CORO_MAGIC_type_state)
387		477
388	INLINE struct coro *	478	ecb_inline MAGIC *
		479	SvSTATEhv_p (pTHX_ SV *coro)
		480	{
		481	MAGIC *mg;
		482
		483	if (ecb_expect_true (
		484	SvTYPE (coro) == SVt_PVHV
		485	&& (mg = CORO_MAGIC_state (coro))
		486	&& mg->mg_virtual == &coro_state_vtbl
		487	))
		488	return mg;
		489
		490	return 0;
		491	}
		492
		493	ecb_inline struct coro *
389	SvSTATE_ (pTHX_ SV *coro)	494	SvSTATE_ (pTHX_ SV *coro)
390	{	495	{
391	HV *stash;
392	MAGIC *mg;	496	MAGIC *mg;
393		497
394	if (SvROK (coro))	498	if (SvROK (coro))
395	coro = SvRV (coro);	499	coro = SvRV (coro);
396		500
397	if (expect_false (SvTYPE (coro) != SVt_PVHV))	501	mg = SvSTATEhv_p (aTHX_ coro);
		502	if (!mg)
398	croak ("Coro::State object required");	503	croak ("Coro::State object required");
399		504
400	stash = SvSTASH (coro);
401	if (expect_false (stash != coro_stash && stash != coro_state_stash))
402	{
403	/* very slow, but rare, check */
404	if (!sv_derived_from (sv_2mortal (newRV_inc (coro)), "Coro::State"))
405	croak ("Coro::State object required");
406	}
407
408	mg = CORO_MAGIC_state (coro);
409	return (struct coro *)mg->mg_ptr;	505	return (struct coro *)mg->mg_ptr;
410	}	506	}
411		507
412	#define SvSTATE(sv) SvSTATE_ (aTHX_ (sv))	508	#define SvSTATE(sv) SvSTATE_ (aTHX_ (sv))
413		509
…		…
416	#define SvSTATE_current SvSTATE_hv (SvRV (coro_current))	512	#define SvSTATE_current SvSTATE_hv (SvRV (coro_current))
417		513
418	/*****************************************************************************/	514	/*****************************************************************************/
419	/* padlist management and caching */	515	/* padlist management and caching */
420		516
421	static AV *	517	ecb_inline PADLIST *
422	coro_derive_padlist (pTHX_ CV *cv)	518	coro_derive_padlist (pTHX_ CV *cv)
423	{	519	{
424	AV *padlist = CvPADLIST (cv);	520	PADLIST *padlist = CvPADLIST (cv);
425	AV *newpadlist, *newpad;	521	PADLIST *newpadlist;
		522	PAD *newpad;
		523	PADOFFSET off = PadlistMAX (padlist) + 1;
426		524
427	newpadlist = newAV ();	525	#if NEWPADAPI
		526
		527	/* if we had the original CvDEPTH, we might be able to steal the CvDEPTH+1 entry instead */
		528	/* 20131102194744.GA6705@schmorp.de, 20131102195825.2013.qmail@lists-nntp.develooper.com */
		529	while (!PadlistARRAY (padlist)[off - 1])
		530	--off;
		531
		532	Perl_pad_push (aTHX_ padlist, off);
		533
		534	newpad = PadlistARRAY (padlist)[off];
		535	PadlistARRAY (padlist)[off] = 0;
		536
		537	#else
		538
		539	#if PERL_VERSION_ATLEAST (5,10,0)
		540	Perl_pad_push (aTHX_ padlist, off);
		541	#else
		542	Perl_pad_push (aTHX_ padlist, off, 1);
		543	#endif
		544
		545	newpad = PadlistARRAY (padlist)[off];
		546	PadlistMAX (padlist) = off - 1;
		547
		548	#endif
		549
		550	newPADLIST (newpadlist);
		551	#if !PERL_VERSION_ATLEAST(5,15,3)
		552	/* Padlists are AvREAL as of 5.15.3. See perl bug #98092 and perl commit 7d953ba. */
428	AvREAL_off (newpadlist);	553	AvREAL_off (newpadlist);
429	#if PERL_VERSION_ATLEAST (5,10,0)
430	Perl_pad_push (aTHX_ padlist, AvFILLp (padlist) + 1);
431	#else
432	Perl_pad_push (aTHX_ padlist, AvFILLp (padlist) + 1, 1);
433	#endif	554	#endif
434	newpad = (AV *)AvARRAY (padlist)[AvFILLp (padlist)];
435	--AvFILLp (padlist);
436		555
437	av_store (newpadlist, 0, SvREFCNT_inc_NN (AvARRAY (padlist)[0]));	556	/* Already extended to 2 elements by newPADLIST. */
438	av_store (newpadlist, 1, (SV *)newpad);	557	PadlistMAX (newpadlist) = 1;
		558	PadlistNAMES (newpadlist) = (PADNAMELIST *)SvREFCNT_inc_NN (PadlistNAMES (padlist));
		559	PadlistARRAY (newpadlist)[1] = newpad;
439		560
440	return newpadlist;	561	return newpadlist;
441	}	562	}
442		563
443	static void	564	ecb_inline void
444	free_padlist (pTHX_ AV *padlist)	565	free_padlist (pTHX_ PADLIST *padlist)
445	{	566	{
446	/* may be during global destruction */	567	/* may be during global destruction */
447	if (!IN_DESTRUCT)	568	if (!IN_DESTRUCT)
448	{	569	{
449	I32 i = AvFILLp (padlist);	570	I32 i = PadlistMAX (padlist);
450		571
451	while (i > 0) /* special-case index 0 */	572	while (i > 0) /* special-case index 0 */
452	{	573	{
453	/* we try to be extra-careful here */	574	/* we try to be extra-careful here */
454	AV *av = (AV *)AvARRAY (padlist)[i--];	575	PAD *pad = PadlistARRAY (padlist)[i--];
455	I32 j = AvFILLp (av);
456		576
		577	if (pad)
		578	{
		579	I32 j = PadMAX (pad);
		580
457	while (j >= 0)	581	while (j >= 0)
458	SvREFCNT_dec (AvARRAY (av)[j--]);	582	SvREFCNT_dec (PadARRAY (pad)[j--]);
459		583
460	AvFILLp (av) = -1;	584	PadMAX (pad) = -1;
461	SvREFCNT_dec (av);	585	SvREFCNT_dec (pad);
		586	}
462	}	587	}
463		588
464	SvREFCNT_dec (AvARRAY (padlist)[0]);	589	SvREFCNT_dec (PadlistNAMES (padlist));
465		590
		591	#if NEWPADAPI
		592	Safefree (PadlistARRAY (padlist));
		593	Safefree (padlist);
		594	#else
466	AvFILLp (padlist) = -1;	595	AvFILLp (padlist) = -1;
		596	AvREAL_off (padlist);
467	SvREFCNT_dec ((SV*)padlist);	597	SvREFCNT_dec ((SV*)padlist);
		598	#endif
468	}	599	}
469	}	600	}
470		601
471	static int	602	static int
472	coro_cv_free (pTHX_ SV *sv, MAGIC *mg)	603	coro_cv_free (pTHX_ SV *sv, MAGIC *mg)
473	{	604	{
474	AV *padlist;	605	PADLIST *padlist;
475	AV *av = (AV *)mg->mg_obj;	606	PADLIST **padlists = (PADLIST **)(mg->mg_ptr + sizeof(size_t));
		607	size_t len = *(size_t *)mg->mg_ptr;
476		608
477	/* casting is fun. */	609	/* perl manages to free our internal AV and _then_ call us */
478	while (&PL_sv_undef != (SV *)(padlist = (AV *)av_pop (av)))	610	if (IN_DESTRUCT)
		611	return 0;
		612
		613	while (len--)
479	free_padlist (aTHX_ padlist);	614	free_padlist (aTHX_ padlists[len]);
480
481	SvREFCNT_dec (av); /* sv_magicext increased the refcount */
482		615
483	return 0;	616	return 0;
484	}	617	}
485		618
486	static MGVTBL coro_cv_vtbl = {	619	static MGVTBL coro_cv_vtbl = {
487	0, 0, 0, 0,	620	0, 0, 0, 0,
488	coro_cv_free	621	coro_cv_free
489	};	622	};
490		623
491	/* the next two functions merely cache the padlists */	624	/* the next two functions merely cache the padlists */
492	static void	625	ecb_inline void
493	get_padlist (pTHX_ CV *cv)	626	get_padlist (pTHX_ CV *cv)
494	{	627	{
495	MAGIC *mg = CORO_MAGIC_cv (cv);	628	MAGIC *mg = CORO_MAGIC_cv (cv);
496	AV *av;	629	size_t *lenp;
497		630
498	if (expect_true (mg && AvFILLp ((av = (AV *)mg->mg_obj)) >= 0))	631	if (ecb_expect_true (mg && *(lenp = (size_t *)mg->mg_ptr)))
499	CvPADLIST (cv) = (AV *)AvARRAY (av)[AvFILLp (av)--];	632	CvPADLIST (cv) = ((PADLIST **)(mg->mg_ptr + sizeof(size_t)))[--*lenp];
500	else	633	else
501	{	634	{
502	#if CORO_PREFER_PERL_FUNCTIONS	635	#if CORO_PREFER_PERL_FUNCTIONS
503	/* this is probably cleaner? but also slower! */	636	/* this is probably cleaner? but also slower! */
504	/* in practise, it seems to be less stable */	637	/* in practise, it seems to be less stable */
…		…
510	CvPADLIST (cv) = coro_derive_padlist (aTHX_ cv);	643	CvPADLIST (cv) = coro_derive_padlist (aTHX_ cv);
511	#endif	644	#endif
512	}	645	}
513	}	646	}
514		647
515	static void	648	ecb_inline void
516	put_padlist (pTHX_ CV *cv)	649	put_padlist (pTHX_ CV *cv)
517	{	650	{
518	MAGIC *mg = CORO_MAGIC_cv (cv);	651	MAGIC *mg = CORO_MAGIC_cv (cv);
519	AV *av;
520		652
521	if (expect_false (!mg))	653	if (ecb_expect_false (!mg))
		654	{
522	mg = sv_magicext ((SV *)cv, (SV *)newAV (), CORO_MAGIC_type_cv, &coro_cv_vtbl, 0, 0);	655	mg = sv_magicext ((SV *)cv, 0, CORO_MAGIC_type_cv, &coro_cv_vtbl, 0, 0);
		656	Newz (0, mg->mg_ptr ,sizeof (size_t) + sizeof (PADLIST *), char);
		657	mg->mg_len = 1; /* so mg_free frees mg_ptr */
		658	}
		659	else
		660	Renew (mg->mg_ptr,
		661	sizeof(size_t) + (*(size_t *)mg->mg_ptr + 1) * sizeof(PADLIST *),
		662	char);
523		663
524	av = (AV *)mg->mg_obj;	664	((PADLIST **)(mg->mg_ptr + sizeof (size_t))) [(*(size_t *)mg->mg_ptr)++] = CvPADLIST (cv);
525
526	if (expect_false (AvFILLp (av) >= AvMAX (av)))
527	av_extend (av, AvFILLp (av) + 1);
528
529	AvARRAY (av)[++AvFILLp (av)] = (SV *)CvPADLIST (cv);
530	}	665	}
531		666
532	/** load & save, init *******************************************************/	667	/** load & save, init *******************************************************/
		668
		669	ecb_inline void
		670	swap_sv (SV *a, SV *b)
		671	{
		672	const U32 keep = SVs_PADSTALE | SVs_PADTMP | SVs_PADMY; /* keep these flags */
		673	SV tmp;
		674
		675	/* swap sv_any */
		676	SvANY (&tmp) = SvANY (a); SvANY (a) = SvANY (b); SvANY (b) = SvANY (&tmp);
		677
		678	/* swap sv_flags */
		679	SvFLAGS (&tmp) = SvFLAGS (a);
		680	SvFLAGS (a) = (SvFLAGS (a) & keep) | (SvFLAGS (b ) & ~keep);
		681	SvFLAGS (b) = (SvFLAGS (b) & keep) | (SvFLAGS (&tmp) & ~keep);
		682
		683	#if PERL_VERSION_ATLEAST (5,10,0)
		684	/* perl 5.10 and later complicates this _quite_ a bit, but it also
		685	* is much faster, so no quarrels here. alternatively, we could
		686	* sv_upgrade to avoid this.
		687	*/
		688	{
		689	/* swap sv_u */
		690	tmp.sv_u = a->sv_u; a->sv_u = b->sv_u; b->sv_u = tmp.sv_u;
		691
		692	/* if SvANY points to the head, we need to adjust the pointers,
		693	* as the pointer for a still points to b, and maybe vice versa.
		694	*/
		695	#define svany_in_head(type) \
		696	(((1 << SVt_NULL) | (1 << SVt_BIND) | (1 << SVt_IV) | (1 << SVt_RV)) & (1 << (type)))
		697
		698	if (svany_in_head (SvTYPE (a)))
		699	SvANY (a) = (void *)((PTRV)SvANY (a) - (PTRV)b + (PTRV)a);
		700
		701	if (svany_in_head (SvTYPE (b)))
		702	SvANY (b) = (void *)((PTRV)SvANY (b) - (PTRV)a + (PTRV)b);
		703	}
		704	#endif
		705	}
		706
		707	/* swap sv heads, at least logically */
		708	static void
		709	swap_svs (pTHX_ Coro__State c)
		710	{
		711	int i;
		712
		713	for (i = 0; i <= AvFILLp (c->swap_sv); i += 2)
		714	swap_sv (AvARRAY (c->swap_sv)[i], AvARRAY (c->swap_sv)[i + 1]);
		715	}
		716
		717	#define SWAP_SVS(coro) \
		718	if (ecb_expect_false ((coro)->swap_sv)) \
		719	swap_svs (aTHX_ (coro))
533		720
534	static void	721	static void
535	on_enterleave_call (pTHX_ SV *cb);	722	on_enterleave_call (pTHX_ SV *cb);
536		723
537	static void	724	static void
…		…
540	perl_slots *slot = c->slot;	727	perl_slots *slot = c->slot;
541	c->slot = 0;	728	c->slot = 0;
542		729
543	PL_mainstack = c->mainstack;	730	PL_mainstack = c->mainstack;
544		731
545	GvSV (PL_defgv) = slot->defsv;	732	#if CORO_JIT
546	GvAV (PL_defgv) = slot->defav;	733	load_perl_slots (slot);
547	GvSV (PL_errgv) = slot->errsv;	734	#else
548	GvSV (irsgv) = slot->irsgv;
549	GvHV (PL_hintgv) = slot->hinthv;
550
551	#define VAR(name,type) PL_ ## name = slot->name;	735	#define VARx(name,expr,type) expr = slot->name;
552	# include "state.h"	736	#include "state.h"
553	#undef VAR	737	#endif
554		738
555	{	739	{
556	dSP;	740	dSP;
557		741
558	CV *cv;	742	CV *cv;
559		743
560	/* now do the ugly restore mess */	744	/* now do the ugly restore mess */
561	while (expect_true (cv = (CV *)POPs))	745	while (ecb_expect_true (cv = (CV *)POPs))
562	{	746	{
563	put_padlist (aTHX_ cv); /* mark this padlist as available */	747	put_padlist (aTHX_ cv); /* mark this padlist as available */
564	CvDEPTH (cv) = PTR2IV (POPs);	748	CvDEPTH (cv) = PTR2IV (POPs);
565	CvPADLIST (cv) = (AV *)POPs;	749	CvPADLIST (cv) = (PADLIST *)POPs;
566	}	750	}
567		751
568	PUTBACK;	752	PUTBACK;
569	}	753	}
570		754
571	slf_frame = c->slf_frame;	755	slf_frame = c->slf_frame;
572	CORO_THROW = c->except;	756	CORO_THROW = c->except;
573		757
		758	if (ecb_expect_false (enable_times))
		759	{
		760	if (ecb_expect_false (!times_valid))
		761	coro_times_update ();
		762
		763	coro_times_sub (c);
		764	}
		765
574	if (expect_false (c->on_enter))	766	if (ecb_expect_false (c->on_enter))
575	{	767	{
576	int i;	768	int i;
577		769
578	for (i = 0; i <= AvFILLp (c->on_enter); ++i)	770	for (i = 0; i <= AvFILLp (c->on_enter); ++i)
579	on_enterleave_call (AvARRAY (c->on_enter)[i]);	771	on_enterleave_call (aTHX_ AvARRAY (c->on_enter)[i]);
580	}	772	}
		773
		774	SWAP_SVS (c);
581	}	775	}
582		776
583	static void	777	static void
584	save_perl (pTHX_ Coro__State c)	778	save_perl (pTHX_ Coro__State c)
585	{	779	{
		780	SWAP_SVS (c);
		781
586	if (expect_false (c->on_leave))	782	if (ecb_expect_false (c->on_leave))
587	{	783	{
588	int i;	784	int i;
589		785
590	for (i = AvFILLp (c->on_leave); i >= 0; --i)	786	for (i = AvFILLp (c->on_leave); i >= 0; --i)
591	on_enterleave_call (AvARRAY (c->on_leave)[i]);	787	on_enterleave_call (aTHX_ AvARRAY (c->on_leave)[i]);
		788	}
		789
		790	times_valid = 0;
		791
		792	if (ecb_expect_false (enable_times))
		793	{
		794	coro_times_update (); times_valid = 1;
		795	coro_times_add (c);
592	}	796	}
593		797
594	c->except = CORO_THROW;	798	c->except = CORO_THROW;
595	c->slf_frame = slf_frame;	799	c->slf_frame = slf_frame;
596		800
…		…
607		811
608	XPUSHs (Nullsv);	812	XPUSHs (Nullsv);
609	/* this loop was inspired by pp_caller */	813	/* this loop was inspired by pp_caller */
610	for (;;)	814	for (;;)
611	{	815	{
612	while (expect_true (cxix >= 0))	816	while (ecb_expect_true (cxix >= 0))
613	{	817	{
614	PERL_CONTEXT *cx = &ccstk[cxix--];	818	PERL_CONTEXT *cx = &ccstk[cxix--];
615		819
616	if (expect_true (CxTYPE (cx) == CXt_SUB || CxTYPE (cx) == CXt_FORMAT))	820	if (ecb_expect_true (CxTYPE (cx) == CXt_SUB) || ecb_expect_false (CxTYPE (cx) == CXt_FORMAT))
617	{	821	{
618	CV *cv = cx->blk_sub.cv;	822	CV *cv = cx->blk_sub.cv;
619		823
620	if (expect_true (CvDEPTH (cv)))	824	if (ecb_expect_true (CvDEPTH (cv)))
621	{	825	{
622	EXTEND (SP, 3);	826	EXTEND (SP, 3);
623	PUSHs ((SV *)CvPADLIST (cv));	827	PUSHs ((SV *)CvPADLIST (cv));
624	PUSHs (INT2PTR (SV *, (IV)CvDEPTH (cv)));	828	PUSHs (INT2PTR (SV *, (IV)CvDEPTH (cv)));
625	PUSHs ((SV *)cv);	829	PUSHs ((SV *)cv);
…		…
628	get_padlist (aTHX_ cv);	832	get_padlist (aTHX_ cv);
629	}	833	}
630	}	834	}
631	}	835	}
632		836
633	if (expect_true (top_si->si_type == PERLSI_MAIN))	837	if (ecb_expect_true (top_si->si_type == PERLSI_MAIN))
634	break;	838	break;
635		839
636	top_si = top_si->si_prev;	840	top_si = top_si->si_prev;
637	ccstk = top_si->si_cxstack;	841	ccstk = top_si->si_cxstack;
638	cxix = top_si->si_cxix;	842	cxix = top_si->si_cxix;
…		…
640		844
641	PUTBACK;	845	PUTBACK;
642	}	846	}
643		847
644	/* allocate some space on the context stack for our purposes */	848	/* allocate some space on the context stack for our purposes */
645	/* we manually unroll here, as usually 2 slots is enough */	849	if (ecb_expect_false (cxstack_ix + (int)SLOT_COUNT >= cxstack_max))
646	if (SLOT_COUNT >= 1) CXINC;
647	if (SLOT_COUNT >= 2) CXINC;
648	if (SLOT_COUNT >= 3) CXINC;
649	{	850	{
650	int i;	851	unsigned int i;
		852
651	for (i = 3; i < SLOT_COUNT; ++i)	853	for (i = 0; i < SLOT_COUNT; ++i)
652	CXINC;	854	CXINC;
653	}	855
654	cxstack_ix -= SLOT_COUNT; /* undo allocation */	856	cxstack_ix -= SLOT_COUNT; /* undo allocation */
		857	}
655		858
656	c->mainstack = PL_mainstack;	859	c->mainstack = PL_mainstack;
657		860
658	{	861	{
659	perl_slots *slot = c->slot = (perl_slots *)(cxstack + cxstack_ix + 1);	862	perl_slots *slot = c->slot = (perl_slots *)(cxstack + cxstack_ix + 1);
660		863
661	slot->defav = GvAV (PL_defgv);	864	#if CORO_JIT
662	slot->defsv = DEFSV;	865	save_perl_slots (slot);
663	slot->errsv = ERRSV;	866	#else
664	slot->irsgv = GvSV (irsgv);
665	slot->hinthv = GvHV (PL_hintgv);
666
667	#define VAR(name,type) slot->name = PL_ ## name;	867	#define VARx(name,expr,type) slot->name = expr;
668	# include "state.h"	868	#include "state.h"
669	#undef VAR	869	#endif
670	}	870	}
671	}	871	}
672		872
673	/*	873	/*
674	* allocate various perl stacks. This is almost an exact copy	874	* allocate various perl stacks. This is almost an exact copy
…		…
680	# define coro_init_stacks(thx) init_stacks ()	880	# define coro_init_stacks(thx) init_stacks ()
681	#else	881	#else
682	static void	882	static void
683	coro_init_stacks (pTHX)	883	coro_init_stacks (pTHX)
684	{	884	{
685	PL_curstackinfo = new_stackinfo(32, 8);	885	PL_curstackinfo = new_stackinfo(32, 4 + SLOT_COUNT); /* 3 is minimum due to perl rounding down in scope.c:GROW() */
686	PL_curstackinfo->si_type = PERLSI_MAIN;	886	PL_curstackinfo->si_type = PERLSI_MAIN;
687	PL_curstack = PL_curstackinfo->si_stack;	887	PL_curstack = PL_curstackinfo->si_stack;
688	PL_mainstack = PL_curstack; /* remember in case we switch stacks */	888	PL_mainstack = PL_curstack; /* remember in case we switch stacks */
689		889
690	PL_stack_base = AvARRAY(PL_curstack);	890	PL_stack_base = AvARRAY(PL_curstack);
…		…
705	#endif	905	#endif
706		906
707	New(54,PL_scopestack,8,I32);	907	New(54,PL_scopestack,8,I32);
708	PL_scopestack_ix = 0;	908	PL_scopestack_ix = 0;
709	PL_scopestack_max = 8;	909	PL_scopestack_max = 8;
		910	#if HAS_SCOPESTACK_NAME
		911	New(54,PL_scopestack_name,8,const char*);
		912	#endif
710		913
711	New(54,PL_savestack,24,ANY);	914	New(54,PL_savestack,24,ANY);
712	PL_savestack_ix = 0;	915	PL_savestack_ix = 0;
713	PL_savestack_max = 24;	916	PL_savestack_max = 24;
714		917
…		…
742	}	945	}
743		946
744	Safefree (PL_tmps_stack);	947	Safefree (PL_tmps_stack);
745	Safefree (PL_markstack);	948	Safefree (PL_markstack);
746	Safefree (PL_scopestack);	949	Safefree (PL_scopestack);
		950	#if HAS_SCOPESTACK_NAME
		951	Safefree (PL_scopestack_name);
		952	#endif
747	Safefree (PL_savestack);	953	Safefree (PL_savestack);
748	#if !PERL_VERSION_ATLEAST (5,10,0)	954	#if !PERL_VERSION_ATLEAST (5,10,0)
749	Safefree (PL_retstack);	955	Safefree (PL_retstack);
750	#endif	956	#endif
751	}	957	}
…		…
797	#endif	1003	#endif
798		1004
799	/*	1005	/*
800	* This overrides the default magic get method of %SIG elements.	1006	* This overrides the default magic get method of %SIG elements.
801	* The original one doesn't provide for reading back of PL_diehook/PL_warnhook	1007	* The original one doesn't provide for reading back of PL_diehook/PL_warnhook
802	* and instead of trying to save and restore the hash elements, we just provide	1008	* and instead of trying to save and restore the hash elements (extremely slow),
803	* readback here.	1009	* we just provide our own readback here.
804	*/	1010	*/
805	static int	1011	static int ecb_cold
806	coro_sigelem_get (pTHX_ SV *sv, MAGIC *mg)	1012	coro_sigelem_get (pTHX_ SV *sv, MAGIC *mg)
807	{	1013	{
808	const char *s = MgPV_nolen_const (mg);	1014	const char *s = MgPV_nolen_const (mg);
809		1015
810	if (*s == '_')	1016	if (*s == '_')
811	{	1017	{
812	SV **svp = 0;	1018	SV **svp = 0;
813		1019
814	if (strEQ (s, "__DIE__" )) svp = &PL_diehook;	1020	if (strEQ (s, "__DIE__" )) svp = &PL_diehook;
815	if (strEQ (s, "__WARN__")) svp = &PL_warnhook;	1021	if (strEQ (s, "__WARN__")) svp = &PL_warnhook;
816		1022
817	if (svp)	1023	if (svp)
818	{	1024	{
819	sv_setsv (sv, *svp ? *svp : &PL_sv_undef);	1025	SV *ssv;
		1026
		1027	if (!*svp)
		1028	ssv = &PL_sv_undef;
		1029	else if (SvTYPE (*svp) == SVt_PVCV) /* perlio directly stores a CV in warnhook. ugh. */
		1030	ssv = sv_2mortal (newRV_inc (*svp));
		1031	else
		1032	ssv = *svp;
		1033
		1034	sv_setsv (sv, ssv);
820	return 0;	1035	return 0;
821	}	1036	}
822	}	1037	}
823		1038
824	return orig_sigelem_get ? orig_sigelem_get (aTHX_ sv, mg) : 0;	1039	return orig_sigelem_get ? orig_sigelem_get (aTHX_ sv, mg) : 0;
825	}	1040	}
826		1041
827	static int	1042	static int ecb_cold
828	coro_sigelem_clr (pTHX_ SV *sv, MAGIC *mg)	1043	coro_sigelem_clr (pTHX_ SV *sv, MAGIC *mg)
829	{	1044	{
830	const char *s = MgPV_nolen_const (mg);	1045	const char *s = MgPV_nolen_const (mg);
831		1046
832	if (*s == '_')	1047	if (*s == '_')
…		…
846	}	1061	}
847		1062
848	return orig_sigelem_clr ? orig_sigelem_clr (aTHX_ sv, mg) : 0;	1063	return orig_sigelem_clr ? orig_sigelem_clr (aTHX_ sv, mg) : 0;
849	}	1064	}
850		1065
851	static int	1066	static int ecb_cold
852	coro_sigelem_set (pTHX_ SV *sv, MAGIC *mg)	1067	coro_sigelem_set (pTHX_ SV *sv, MAGIC *mg)
853	{	1068	{
854	const char *s = MgPV_nolen_const (mg);	1069	const char *s = MgPV_nolen_const (mg);
855		1070
856	if (*s == '_')	1071	if (*s == '_')
…		…
889	slf_check_repeat (pTHX_ struct CoroSLF *frame)	1104	slf_check_repeat (pTHX_ struct CoroSLF *frame)
890	{	1105	{
891	return 1;	1106	return 1;
892	}	1107	}
893		1108
894	static UNOP coro_setup_op;	1109	static UNOP init_perl_op;
895		1110
896	static void NOINLINE /* noinline to keep it out of the transfer fast path */	1111	ecb_noinline static void /* noinline to keep it out of the transfer fast path */
897	coro_setup (pTHX_ struct coro *coro)	1112	init_perl (pTHX_ struct coro *coro)
898	{	1113	{
899	/*	1114	/*
900	* emulate part of the perl startup here.	1115	* emulate part of the perl startup here.
901	*/	1116	*/
902	coro_init_stacks (aTHX);	1117	coro_init_stacks (aTHX);
…		…
909	PL_comppad_name_fill = 0;	1124	PL_comppad_name_fill = 0;
910	PL_comppad_name_floor = 0;	1125	PL_comppad_name_floor = 0;
911	PL_curpm = 0;	1126	PL_curpm = 0;
912	PL_curpad = 0;	1127	PL_curpad = 0;
913	PL_localizing = 0;	1128	PL_localizing = 0;
914	PL_dirty = 0;
915	PL_restartop = 0;	1129	PL_restartop = 0;
916	#if PERL_VERSION_ATLEAST (5,10,0)	1130	#if PERL_VERSION_ATLEAST (5,10,0)
917	PL_parser = 0;	1131	PL_parser = 0;
918	#endif	1132	#endif
919	PL_hints = 0;	1133	PL_hints = 0;
920		1134
921	/* recreate the die/warn hooks */	1135	/* recreate the die/warn hooks */
922	PL_diehook = 0; SvSetMagicSV (*hv_fetch (hv_sig, "__DIE__" , sizeof ("__DIE__" ) - 1, 1), rv_diehook );	1136	PL_diehook = SvREFCNT_inc (rv_diehook);
923	PL_warnhook = 0; SvSetMagicSV (*hv_fetch (hv_sig, "__WARN__", sizeof ("__WARN__") - 1, 1), rv_warnhook);	1137	PL_warnhook = SvREFCNT_inc (rv_warnhook);
924		1138
925	GvSV (PL_defgv) = newSV (0);	1139	GvSV (PL_defgv) = newSV (0);
926	GvAV (PL_defgv) = coro->args; coro->args = 0;	1140	GvAV (PL_defgv) = coro->args; coro->args = 0;
927	GvSV (PL_errgv) = newSV (0);	1141	GvSV (PL_errgv) = newSV (0);
928	GvSV (irsgv) = newSVpvn ("\n", 1); sv_magic (GvSV (irsgv), (SV *)irsgv, PERL_MAGIC_sv, "/", 0);	1142	GvSV (irsgv) = newSVpvn ("\n", 1); sv_magic (GvSV (irsgv), (SV *)irsgv, PERL_MAGIC_sv, "/", 0);
929	GvHV (PL_hintgv) = 0;	1143	GvHV (PL_hintgv) = 0;
…		…
949	/* this newly created coroutine might be run on an existing cctx which most	1163	/* this newly created coroutine might be run on an existing cctx which most
950	* likely was suspended in pp_slf, so we have to emulate entering pp_slf here.	1164	* likely was suspended in pp_slf, so we have to emulate entering pp_slf here.
951	*/	1165	*/
952	slf_frame.prepare = prepare_nop; /* provide a nop function for an eventual pp_slf */	1166	slf_frame.prepare = prepare_nop; /* provide a nop function for an eventual pp_slf */
953	slf_frame.check = slf_check_nop; /* signal pp_slf to not repeat */	1167	slf_frame.check = slf_check_nop; /* signal pp_slf to not repeat */
		1168	slf_frame.destroy = 0;
954		1169
955	/* and we have to provide the pp_slf op in any case, so pp_slf can skip it */	1170	/* and we have to provide the pp_slf op in any case, so pp_slf can skip it */
956	coro_setup_op.op_next = PL_op;	1171	init_perl_op.op_next = PL_op;
957	coro_setup_op.op_type = OP_ENTERSUB;	1172	init_perl_op.op_type = OP_ENTERSUB;
958	coro_setup_op.op_ppaddr = pp_slf;	1173	init_perl_op.op_ppaddr = pp_slf;
959	/* no flags etc. required, as an init function won't be called */	1174	/* no flags etc. required, as an init function won't be called */
960		1175
961	PL_op = (OP *)&coro_setup_op;	1176	PL_op = (OP *)&init_perl_op;
962		1177
963	/* copy throw, in case it was set before coro_setup */	1178	/* copy throw, in case it was set before init_perl */
964	CORO_THROW = coro->except;	1179	CORO_THROW = coro->except;
		1180
		1181	SWAP_SVS (coro);
		1182
		1183	if (ecb_expect_false (enable_times))
		1184	{
		1185	coro_times_update ();
		1186	coro_times_sub (coro);
		1187	}
965	}	1188	}
966		1189
967	static void	1190	static void
968	coro_unwind_stacks (pTHX)	1191	coro_unwind_stacks (pTHX)
969	{	1192	{
…		…
984	dounwind (-1);	1207	dounwind (-1);
985	}	1208	}
986	}	1209	}
987		1210
988	static void	1211	static void
989	coro_destruct_perl (pTHX_ struct coro *coro)	1212	destroy_perl (pTHX_ struct coro *coro)
990	{	1213	{
		1214	SV *svf [9];
		1215
		1216	{
		1217	SV *old_current = SvRV (coro_current);
		1218	struct coro *current = SvSTATE (old_current);
		1219
		1220	assert (("FATAL: tried to destroy currently running coroutine", coro->mainstack != PL_mainstack));
		1221
		1222	save_perl (aTHX_ current);
		1223
		1224	/* this will cause transfer_check to croak on block*/
		1225	SvRV_set (coro_current, (SV *)coro->hv);
		1226
		1227	load_perl (aTHX_ coro);
		1228
991	coro_unwind_stacks (aTHX);	1229	coro_unwind_stacks (aTHX);
992		1230
993	SvREFCNT_dec (GvSV (PL_defgv));	1231	/* restore swapped sv's */
994	SvREFCNT_dec (GvAV (PL_defgv));	1232	SWAP_SVS (coro);
995	SvREFCNT_dec (GvSV (PL_errgv));
996	SvREFCNT_dec (PL_defoutgv);
997	SvREFCNT_dec (PL_rs);
998	SvREFCNT_dec (GvSV (irsgv));
999	SvREFCNT_dec (GvHV (PL_hintgv));
1000		1233
1001	SvREFCNT_dec (PL_diehook);	1234	coro_destruct_stacks (aTHX);
1002	SvREFCNT_dec (PL_warnhook);	1235
		1236	/* now save some sv's to be free'd later */
		1237	svf [0] = GvSV (PL_defgv);
		1238	svf [1] = (SV *)GvAV (PL_defgv);
		1239	svf [2] = GvSV (PL_errgv);
		1240	svf [3] = (SV *)PL_defoutgv;
		1241	svf [4] = PL_rs;
		1242	svf [5] = GvSV (irsgv);
		1243	svf [6] = (SV *)GvHV (PL_hintgv);
		1244	svf [7] = PL_diehook;
		1245	svf [8] = PL_warnhook;
		1246	assert (9 == sizeof (svf) / sizeof (*svf));
		1247
		1248	SvRV_set (coro_current, old_current);
		1249
		1250	load_perl (aTHX_ current);
1003		1251	}
		1252
		1253	{
		1254	unsigned int i;
		1255
		1256	for (i = 0; i < sizeof (svf) / sizeof (*svf); ++i)
		1257	SvREFCNT_dec (svf [i]);
		1258
1004	SvREFCNT_dec (coro->saved_deffh);	1259	SvREFCNT_dec (coro->saved_deffh);
1005	SvREFCNT_dec (coro->rouse_cb);	1260	SvREFCNT_dec (coro->rouse_cb);
1006	SvREFCNT_dec (coro->invoke_cb);	1261	SvREFCNT_dec (coro->invoke_cb);
1007	SvREFCNT_dec (coro->invoke_av);	1262	SvREFCNT_dec (coro->invoke_av);
1008		1263	}
1009	coro_destruct_stacks (aTHX);
1010	}	1264	}
1011		1265
1012	INLINE void	1266	ecb_inline void
1013	free_coro_mortal (pTHX)	1267	free_coro_mortal (pTHX)
1014	{	1268	{
1015	if (expect_true (coro_mortal))	1269	if (ecb_expect_true (coro_mortal))
1016	{	1270	{
1017	SvREFCNT_dec (coro_mortal);	1271	SvREFCNT_dec ((SV *)coro_mortal);
1018	coro_mortal = 0;	1272	coro_mortal = 0;
1019	}	1273	}
1020	}	1274	}
1021		1275
1022	static int	1276	static int
…		…
1155		1409
1156	return frame->check (aTHX_ frame); /* execute the restored frame - there must be one */	1410	return frame->check (aTHX_ frame); /* execute the restored frame - there must be one */
1157	}	1411	}
1158		1412
1159	/* initialises PL_top_env and injects a pseudo-slf-call to set the stacklevel */	1413	/* initialises PL_top_env and injects a pseudo-slf-call to set the stacklevel */
1160	static void NOINLINE	1414	static void ecb_noinline
1161	cctx_prepare (pTHX)	1415	cctx_prepare (pTHX)
1162	{	1416	{
1163	PL_top_env = &PL_start_env;	1417	PL_top_env = &PL_start_env;
1164		1418
1165	if (cctx_current->flags & CC_TRACE)	1419	if (cctx_current->flags & CC_TRACE)
…		…
1176	slf_frame.prepare = slf_prepare_set_stacklevel;	1430	slf_frame.prepare = slf_prepare_set_stacklevel;
1177	slf_frame.check = slf_check_set_stacklevel;	1431	slf_frame.check = slf_check_set_stacklevel;
1178	}	1432	}
1179		1433
1180	/* the tail of transfer: execute stuff we can only do after a transfer */	1434	/* the tail of transfer: execute stuff we can only do after a transfer */
1181	INLINE void	1435	ecb_inline void
1182	transfer_tail (pTHX)	1436	transfer_tail (pTHX)
1183	{	1437	{
1184	free_coro_mortal (aTHX);	1438	free_coro_mortal (aTHX);
		1439	}
		1440
		1441	/* try to exit the same way perl's main function would do */
		1442	/* we do not bother resetting the environment or other things *7
		1443	/* that are not, uhm, essential */
		1444	/* this obviously also doesn't work when perl is embedded */
		1445	static void ecb_noinline ecb_cold
		1446	perlish_exit (pTHX)
		1447	{
		1448	int exitstatus = perl_destruct (PL_curinterp);
		1449	perl_free (PL_curinterp);
		1450	exit (exitstatus);
1185	}	1451	}
1186		1452
1187	/*	1453	/*
1188	* this is a _very_ stripped down perl interpreter ;)	1454	* this is a _very_ stripped down perl interpreter ;)
1189	*/	1455	*/
…		…
1211	/* somebody or something will hit me for both perl_run and PL_restartop */	1477	/* somebody or something will hit me for both perl_run and PL_restartop */
1212	PL_restartop = PL_op;	1478	PL_restartop = PL_op;
1213	perl_run (PL_curinterp);	1479	perl_run (PL_curinterp);
1214	/*	1480	/*
1215	* Unfortunately, there is no way to get at the return values of the	1481	* Unfortunately, there is no way to get at the return values of the
1216	* coro body here, as perl_run destroys these	1482	* coro body here, as perl_run destroys these. Likewise, we cannot catch
		1483	* runtime errors here, as this is just a random interpreter, not a thread.
1217	*/	1484	*/
1218		1485
1219	/*	1486	/*
1220	* If perl-run returns we assume exit() was being called or the coro	1487	* If perl-run returns we assume exit() was being called or the coro
1221	* fell off the end, which seems to be the only valid (non-bug)	1488	* fell off the end, which seems to be the only valid (non-bug)
1222	* reason for perl_run to return. We try to exit by jumping to the	1489	* reason for perl_run to return. We try to mimic whatever perl is normally
1223	* bootstrap-time "top" top_env, as we cannot restore the "main"	1490	* doing in that case. YMMV.
1224	* coroutine as Coro has no such concept.
1225	* This actually isn't valid with the pthread backend, but OSes requiring
1226	* that backend are too broken to do it in a standards-compliant way.
1227	*/	1491	*/
1228	PL_top_env = main_top_env;	1492	perlish_exit (aTHX);
1229	JMPENV_JUMP (2); /* I do not feel well about the hardcoded 2 at all */
1230	}	1493	}
1231	}	1494	}
1232		1495
1233	static coro_cctx *	1496	static coro_cctx *
1234	cctx_new ()	1497	cctx_new (void)
1235	{	1498	{
1236	coro_cctx *cctx;	1499	coro_cctx *cctx;
1237		1500
1238	++cctx_count;	1501	++cctx_count;
1239	New (0, cctx, 1, coro_cctx);	1502	New (0, cctx, 1, coro_cctx);
…		…
1245	return cctx;	1508	return cctx;
1246	}	1509	}
1247		1510
1248	/* create a new cctx only suitable as source */	1511	/* create a new cctx only suitable as source */
1249	static coro_cctx *	1512	static coro_cctx *
1250	cctx_new_empty ()	1513	cctx_new_empty (void)
1251	{	1514	{
1252	coro_cctx *cctx = cctx_new ();	1515	coro_cctx *cctx = cctx_new ();
1253		1516
1254	cctx->sptr = 0;	1517	cctx->stack.sptr = 0;
1255	coro_create (&cctx->cctx, 0, 0, 0, 0);	1518	coro_create (&cctx->cctx, 0, 0, 0, 0);
1256		1519
1257	return cctx;	1520	return cctx;
1258	}	1521	}
1259		1522
1260	/* create a new cctx suitable as destination/running a perl interpreter */	1523	/* create a new cctx suitable as destination/running a perl interpreter */
1261	static coro_cctx *	1524	static coro_cctx *
1262	cctx_new_run ()	1525	cctx_new_run (void)
1263	{	1526	{
1264	coro_cctx *cctx = cctx_new ();	1527	coro_cctx *cctx = cctx_new ();
1265	void *stack_start;
1266	size_t stack_size;
1267		1528
1268	#if HAVE_MMAP	1529	if (!coro_stack_alloc (&cctx->stack, cctx_stacksize))
1269	cctx->ssize = ((cctx_stacksize * sizeof (long) + PAGESIZE - 1) / PAGESIZE + CORO_STACKGUARD) * PAGESIZE;
1270	/* mmap supposedly does allocate-on-write for us */
1271	cctx->sptr = mmap (0, cctx->ssize, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_PRIVATE|MAP_ANONYMOUS, 0, 0);
1272
1273	if (cctx->sptr != (void *)-1)
1274	{
1275	#if CORO_STACKGUARD
1276	mprotect (cctx->sptr, CORO_STACKGUARD * PAGESIZE, PROT_NONE);
1277	#endif
1278	stack_start = (char *)cctx->sptr + CORO_STACKGUARD * PAGESIZE;
1279	stack_size = cctx->ssize - CORO_STACKGUARD * PAGESIZE;
1280	cctx->flags |= CC_MAPPED;
1281	}	1530	{
1282	else
1283	#endif
1284	{
1285	cctx->ssize = cctx_stacksize * (long)sizeof (long);
1286	New (0, cctx->sptr, cctx_stacksize, long);
1287
1288	if (!cctx->sptr)
1289	{
1290	perror ("FATAL: unable to allocate stack for coroutine, exiting.");	1531	perror ("FATAL: unable to allocate stack for coroutine, exiting.");
1291	_exit (EXIT_FAILURE);	1532	_exit (EXIT_FAILURE);
1292	}
1293
1294	stack_start = cctx->sptr;
1295	stack_size = cctx->ssize;
1296	}	1533	}
1297		1534
1298	#if CORO_USE_VALGRIND
1299	cctx->valgrind_id = VALGRIND_STACK_REGISTER ((char *)stack_start, (char *)stack_start + stack_size);
1300	#endif
1301
1302	coro_create (&cctx->cctx, cctx_run, (void *)cctx, stack_start, stack_size);	1535	coro_create (&cctx->cctx, cctx_run, (void *)cctx, cctx->stack.sptr, cctx->stack.ssze);
1303		1536
1304	return cctx;	1537	return cctx;
1305	}	1538	}
1306		1539
1307	static void	1540	static void
1308	cctx_destroy (coro_cctx *cctx)	1541	cctx_destroy (coro_cctx *cctx)
1309	{	1542	{
1310	if (!cctx)	1543	if (!cctx)
1311	return;	1544	return;
1312		1545
1313	assert (("FATAL: tried to destroy current cctx", cctx != cctx_current));//D temporary?	1546	assert (("FATAL: tried to destroy current cctx", cctx != cctx_current));
1314		1547
1315	--cctx_count;	1548	--cctx_count;
1316	coro_destroy (&cctx->cctx);	1549	coro_destroy (&cctx->cctx);
1317		1550
1318	/* coro_transfer creates new, empty cctx's */	1551	coro_stack_free (&cctx->stack);
1319	if (cctx->sptr)
1320	{
1321	#if CORO_USE_VALGRIND
1322	VALGRIND_STACK_DEREGISTER (cctx->valgrind_id);
1323	#endif
1324
1325	#if HAVE_MMAP
1326	if (cctx->flags & CC_MAPPED)
1327	munmap (cctx->sptr, cctx->ssize);
1328	else
1329	#endif
1330	Safefree (cctx->sptr);
1331	}
1332		1552
1333	Safefree (cctx);	1553	Safefree (cctx);
1334	}	1554	}
1335		1555
1336	/* wether this cctx should be destructed */	1556	/* wether this cctx should be destructed */
1337	#define CCTX_EXPIRED(cctx) ((cctx)->gen != cctx_gen || ((cctx)->flags & CC_NOREUSE))	1557	#define CCTX_EXPIRED(cctx) ((cctx)->gen != cctx_gen || ((cctx)->flags & CC_NOREUSE))
1338		1558
1339	static coro_cctx *	1559	static coro_cctx *
1340	cctx_get (pTHX)	1560	cctx_get (pTHX)
1341	{	1561	{
1342	while (expect_true (cctx_first))	1562	while (ecb_expect_true (cctx_first))
1343	{	1563	{
1344	coro_cctx *cctx = cctx_first;	1564	coro_cctx *cctx = cctx_first;
1345	cctx_first = cctx->next;	1565	cctx_first = cctx->next;
1346	--cctx_idle;	1566	--cctx_idle;
1347		1567
1348	if (expect_true (!CCTX_EXPIRED (cctx)))	1568	if (ecb_expect_true (!CCTX_EXPIRED (cctx)))
1349	return cctx;	1569	return cctx;
1350		1570
1351	cctx_destroy (cctx);	1571	cctx_destroy (cctx);
1352	}	1572	}
1353		1573
…		…
1355	}	1575	}
1356		1576
1357	static void	1577	static void
1358	cctx_put (coro_cctx *cctx)	1578	cctx_put (coro_cctx *cctx)
1359	{	1579	{
1360	assert (("FATAL: cctx_put called on non-initialised cctx in Coro (please report)", cctx->sptr));	1580	assert (("FATAL: cctx_put called on non-initialised cctx in Coro (please report)", cctx->stack.sptr));
1361		1581
1362	/* free another cctx if overlimit */	1582	/* free another cctx if overlimit */
1363	if (expect_false (cctx_idle >= cctx_max_idle))	1583	if (ecb_expect_false (cctx_idle >= cctx_max_idle))
1364	{	1584	{
1365	coro_cctx *first = cctx_first;	1585	coro_cctx *first = cctx_first;
1366	cctx_first = first->next;	1586	cctx_first = first->next;
1367	--cctx_idle;	1587	--cctx_idle;
1368		1588
…		…
1379	static void	1599	static void
1380	transfer_check (pTHX_ struct coro *prev, struct coro *next)	1600	transfer_check (pTHX_ struct coro *prev, struct coro *next)
1381	{	1601	{
1382	/* TODO: throwing up here is considered harmful */	1602	/* TODO: throwing up here is considered harmful */
1383		1603
1384	if (expect_true (prev != next))	1604	if (ecb_expect_true (prev != next))
1385	{	1605	{
1386	if (expect_false (!(prev->flags & (CF_RUNNING | CF_NEW))))	1606	if (ecb_expect_false (!(prev->flags & (CF_RUNNING | CF_NEW))))
1387	croak ("Coro::State::transfer called with a suspended prev Coro::State, but can only transfer from running or new states,");	1607	croak ("Coro::State::transfer called with a blocked prev Coro::State, but can only transfer from running or new states,");
1388		1608
1389	if (expect_false (next->flags & CF_RUNNING))	1609	if (ecb_expect_false (next->flags & (CF_RUNNING | CF_ZOMBIE | CF_SUSPENDED)))
1390	croak ("Coro::State::transfer called with running next Coro::State, but can only transfer to inactive states,");
1391
1392	if (expect_false (next->flags & CF_DESTROYED))
1393	croak ("Coro::State::transfer called with destroyed next Coro::State, but can only transfer to inactive states,");	1610	croak ("Coro::State::transfer called with running, destroyed or suspended next Coro::State, but can only transfer to inactive states,");
1394		1611
1395	#if !PERL_VERSION_ATLEAST (5,10,0)	1612	#if !PERL_VERSION_ATLEAST (5,10,0)
1396	if (expect_false (PL_lex_state != LEX_NOTPARSING))	1613	if (ecb_expect_false (PL_lex_state != LEX_NOTPARSING))
1397	croak ("Coro::State::transfer called while parsing, but this is not supported in your perl version,");	1614	croak ("Coro::State::transfer called while parsing, but this is not supported in your perl version,");
1398	#endif	1615	#endif
1399	}	1616	}
1400	}	1617	}
1401		1618
1402	/* always use the TRANSFER macro */	1619	/* always use the TRANSFER macro */
1403	static void NOINLINE /* noinline so we have a fixed stackframe */	1620	static void ecb_noinline /* noinline so we have a fixed stackframe */
1404	transfer (pTHX_ struct coro *prev, struct coro *next, int force_cctx)	1621	transfer (pTHX_ struct coro *prev, struct coro *next, int force_cctx)
1405	{	1622	{
1406	dSTACKLEVEL;	1623	dSTACKLEVEL;
1407		1624
1408	/* sometimes transfer is only called to set idle_sp */	1625	/* sometimes transfer is only called to set idle_sp */
1409	if (expect_false (!prev))	1626	if (ecb_expect_false (!prev))
1410	{	1627	{
1411	cctx_current->idle_sp = STACKLEVEL;	1628	cctx_current->idle_sp = STACKLEVEL;
1412	assert (cctx_current->idle_te = PL_top_env); /* just for the side-effect when asserts are enabled */	1629	assert (cctx_current->idle_te = PL_top_env); /* just for the side-effect when asserts are enabled */
1413	}	1630	}
1414	else if (expect_true (prev != next))	1631	else if (ecb_expect_true (prev != next))
1415	{	1632	{
1416	coro_cctx *cctx_prev;	1633	coro_cctx *cctx_prev;
1417		1634
1418	if (expect_false (prev->flags & CF_NEW))	1635	if (ecb_expect_false (prev->flags & CF_NEW))
1419	{	1636	{
1420	/* create a new empty/source context */	1637	/* create a new empty/source context */
1421	prev->flags &= ~CF_NEW;	1638	prev->flags &= ~CF_NEW;
1422	prev->flags |= CF_RUNNING;	1639	prev->flags |= CF_RUNNING;
1423	}	1640	}
…		…
1426	next->flags |= CF_RUNNING;	1643	next->flags |= CF_RUNNING;
1427		1644
1428	/* first get rid of the old state */	1645	/* first get rid of the old state */
1429	save_perl (aTHX_ prev);	1646	save_perl (aTHX_ prev);
1430		1647
1431	if (expect_false (next->flags & CF_NEW))	1648	if (ecb_expect_false (next->flags & CF_NEW))
1432	{	1649	{
1433	/* need to start coroutine */	1650	/* need to start coroutine */
1434	next->flags &= ~CF_NEW;	1651	next->flags &= ~CF_NEW;
1435	/* setup coroutine call */	1652	/* setup coroutine call */
1436	coro_setup (aTHX_ next);	1653	init_perl (aTHX_ next);
1437	}	1654	}
1438	else	1655	else
1439	load_perl (aTHX_ next);	1656	load_perl (aTHX_ next);
1440		1657
1441	/* possibly untie and reuse the cctx */	1658	/* possibly untie and reuse the cctx */
1442	if (expect_true (	1659	if (ecb_expect_true (
1443	cctx_current->idle_sp == STACKLEVEL	1660	cctx_current->idle_sp == STACKLEVEL
1444	&& !(cctx_current->flags & CC_TRACE)	1661	&& !(cctx_current->flags & CC_TRACE)
1445	&& !force_cctx	1662	&& !force_cctx
1446	))	1663	))
1447	{	1664	{
1448	/* I assume that stacklevel is a stronger indicator than PL_top_env changes */	1665	/* I assume that stacklevel is a stronger indicator than PL_top_env changes */
1449	assert (("FATAL: current top_env must equal previous top_env in Coro (please report)", PL_top_env == cctx_current->idle_te));	1666	assert (("FATAL: current top_env must equal previous top_env in Coro (please report)", PL_top_env == cctx_current->idle_te));
1450		1667
1451	/* if the cctx is about to be destroyed we need to make sure we won't see it in cctx_get. */	1668	/* if the cctx is about to be destroyed we need to make sure we won't see it in cctx_get. */
1452	/* without this the next cctx_get might destroy the running cctx while still in use */	1669	/* without this the next cctx_get might destroy the running cctx while still in use */
1453	if (expect_false (CCTX_EXPIRED (cctx_current)))	1670	if (ecb_expect_false (CCTX_EXPIRED (cctx_current)))
1454	if (expect_true (!next->cctx))	1671	if (ecb_expect_true (!next->cctx))
1455	next->cctx = cctx_get (aTHX);	1672	next->cctx = cctx_get (aTHX);
1456		1673
1457	cctx_put (cctx_current);	1674	cctx_put (cctx_current);
1458	}	1675	}
1459	else	1676	else
1460	prev->cctx = cctx_current;	1677	prev->cctx = cctx_current;
1461		1678
1462	++next->usecount;	1679	++next->usecount;
1463		1680
1464	cctx_prev = cctx_current;	1681	cctx_prev = cctx_current;
1465	cctx_current = expect_false (next->cctx) ? next->cctx : cctx_get (aTHX);	1682	cctx_current = ecb_expect_false (next->cctx) ? next->cctx : cctx_get (aTHX);
1466		1683
1467	next->cctx = 0;	1684	next->cctx = 0;
1468		1685
1469	if (expect_false (cctx_prev != cctx_current))	1686	if (ecb_expect_false (cctx_prev != cctx_current))
1470	{	1687	{
1471	cctx_prev->top_env = PL_top_env;	1688	cctx_prev->top_env = PL_top_env;
1472	PL_top_env = cctx_current->top_env;	1689	PL_top_env = cctx_current->top_env;
1473	coro_transfer (&cctx_prev->cctx, &cctx_current->cctx);	1690	coro_transfer (&cctx_prev->cctx, &cctx_current->cctx);
1474	}	1691	}
…		…
1480	#define TRANSFER(ta, force_cctx) transfer (aTHX_ (ta).prev, (ta).next, (force_cctx))	1697	#define TRANSFER(ta, force_cctx) transfer (aTHX_ (ta).prev, (ta).next, (force_cctx))
1481	#define TRANSFER_CHECK(ta) transfer_check (aTHX_ (ta).prev, (ta).next)	1698	#define TRANSFER_CHECK(ta) transfer_check (aTHX_ (ta).prev, (ta).next)
1482		1699
1483	/** high level stuff ********************************************************/	1700	/** high level stuff ********************************************************/
1484		1701
		1702	/* this function is actually Coro, not Coro::State, but we call it from here */
		1703	/* because it is convenient - but it hasn't been declared yet for that reason */
1485	static int	1704	static void
		1705	coro_call_on_destroy (pTHX_ struct coro *coro);
		1706
		1707	static void
1486	coro_state_destroy (pTHX_ struct coro *coro)	1708	coro_state_destroy (pTHX_ struct coro *coro)
1487	{	1709	{
1488	if (coro->flags & CF_DESTROYED)	1710	if (coro->flags & CF_ZOMBIE)
1489	return 0;	1711	return;
1490		1712
1491	if (coro->on_destroy)
1492	coro->on_destroy (aTHX_ coro);	1713	slf_destroy (aTHX_ coro);
1493		1714
1494	coro->flags |= CF_DESTROYED;	1715	coro->flags |= CF_ZOMBIE;
1495		1716
1496	if (coro->flags & CF_READY)	1717	if (coro->flags & CF_READY)
1497	{	1718	{
1498	/* reduce nready, as destroying a ready coro effectively unreadies it */	1719	/* reduce nready, as destroying a ready coro effectively unreadies it */
1499	/* alternative: look through all ready queues and remove the coro */	1720	/* alternative: look through all ready queues and remove the coro */
1500	--coro_nready;	1721	--coro_nready;
1501	}	1722	}
1502	else	1723	else
1503	coro->flags |= CF_READY; /* make sure it is NOT put into the readyqueue */	1724	coro->flags |= CF_READY; /* make sure it is NOT put into the readyqueue */
		1725
		1726	if (coro->next) coro->next->prev = coro->prev;
		1727	if (coro->prev) coro->prev->next = coro->next;
		1728	if (coro == coro_first) coro_first = coro->next;
1504		1729
1505	if (coro->mainstack	1730	if (coro->mainstack
1506	&& coro->mainstack != main_mainstack	1731	&& coro->mainstack != main_mainstack
1507	&& coro->slot	1732	&& coro->slot
1508	&& !PL_dirty)	1733	&& !PL_dirty)
1509	{
1510	struct coro *current = SvSTATE_current;
1511
1512	assert (("FATAL: tried to destroy currently running coroutine", coro->mainstack != PL_mainstack));
1513
1514	save_perl (aTHX_ current);
1515	load_perl (aTHX_ coro);
1516
1517	coro_destruct_perl (aTHX_ coro);	1734	destroy_perl (aTHX_ coro);
1518
1519	load_perl (aTHX_ current);
1520
1521	coro->slot = 0;
1522	}
1523		1735
1524	cctx_destroy (coro->cctx);	1736	cctx_destroy (coro->cctx);
1525	SvREFCNT_dec (coro->startcv);	1737	SvREFCNT_dec (coro->startcv);
1526	SvREFCNT_dec (coro->args);	1738	SvREFCNT_dec (coro->args);
		1739	SvREFCNT_dec (coro->swap_sv);
1527	SvREFCNT_dec (CORO_THROW);	1740	SvREFCNT_dec (CORO_THROW);
1528		1741
1529	if (coro->next) coro->next->prev = coro->prev;	1742	coro_call_on_destroy (aTHX_ coro);
1530	if (coro->prev) coro->prev->next = coro->next;
1531	if (coro == coro_first) coro_first = coro->next;
1532		1743
1533	return 1;	1744	/* more destruction mayhem in coro_state_free */
1534	}	1745	}
1535		1746
1536	static int	1747	static int
1537	coro_state_free (pTHX_ SV *sv, MAGIC *mg)	1748	coro_state_free (pTHX_ SV *sv, MAGIC *mg)
1538	{	1749	{
1539	struct coro *coro = (struct coro *)mg->mg_ptr;	1750	struct coro *coro = (struct coro *)mg->mg_ptr;
1540	mg->mg_ptr = 0;	1751	mg->mg_ptr = 0;
1541		1752
1542	coro->hv = 0;
1543
1544	if (--coro->refcnt < 0)
1545	{
1546	coro_state_destroy (aTHX_ coro);	1753	coro_state_destroy (aTHX_ coro);
		1754	SvREFCNT_dec (coro->on_destroy);
		1755	SvREFCNT_dec (coro->status);
		1756
1547	Safefree (coro);	1757	Safefree (coro);
1548	}
1549		1758
1550	return 0;	1759	return 0;
1551	}	1760	}
1552		1761
1553	static int	1762	static int ecb_cold
1554	coro_state_dup (pTHX_ MAGIC *mg, CLONE_PARAMS *params)	1763	coro_state_dup (pTHX_ MAGIC *mg, CLONE_PARAMS *params)
1555	{	1764	{
1556	struct coro *coro = (struct coro *)mg->mg_ptr;	1765	/* called when perl clones the current process the slow way (windows process emulation) */
1557		1766	/* WE SIMply nuke the pointers in the copy, causing perl to croak */
1558	++coro->refcnt;	1767	mg->mg_ptr = 0;
		1768	mg->mg_virtual = 0;
1559		1769
1560	return 0;	1770	return 0;
1561	}	1771	}
1562		1772
1563	static MGVTBL coro_state_vtbl = {	1773	static MGVTBL coro_state_vtbl = {
…		…
1586		1796
1587	prepare_transfer (aTHX_ &ta, prev_sv, next_sv);	1797	prepare_transfer (aTHX_ &ta, prev_sv, next_sv);
1588	TRANSFER (ta, 1);	1798	TRANSFER (ta, 1);
1589	}	1799	}
1590		1800
1591	/*****************************************************************************/
1592	/* gensub: simple closure generation utility */
1593
1594	#define GENSUB_ARG CvXSUBANY (cv).any_ptr
1595
1596	/* create a closure from XS, returns a code reference */
1597	/* the arg can be accessed via GENSUB_ARG from the callback */
1598	/* the callback must use dXSARGS/XSRETURN */
1599	static SV *
1600	gensub (pTHX_ void (*xsub)(pTHX_ CV *), void *arg)
1601	{
1602	CV *cv = (CV *)newSV (0);
1603
1604	sv_upgrade ((SV *)cv, SVt_PVCV);
1605
1606	CvANON_on (cv);
1607	CvISXSUB_on (cv);
1608	CvXSUB (cv) = xsub;
1609	GENSUB_ARG = arg;
1610
1611	return newRV_noinc ((SV *)cv);
1612	}
1613
1614	/** Coro ********************************************************************/	1801	/** Coro ********************************************************************/
1615		1802
1616	INLINE void	1803	ecb_inline void
1617	coro_enq (pTHX_ struct coro *coro)	1804	coro_enq (pTHX_ struct coro *coro)
1618	{	1805	{
1619	av_push (coro_ready [coro->prio - PRIO_MIN], SvREFCNT_inc_NN (coro->hv));	1806	struct coro **ready = coro_ready [coro->prio - CORO_PRIO_MIN];
1620	}
1621		1807
1622	INLINE SV *	1808	SvREFCNT_inc_NN (coro->hv);
		1809
		1810	coro->next_ready = 0;
		1811	*(ready [0] ? &ready [1]->next_ready : &ready [0]) = coro;
		1812	ready [1] = coro;
		1813	}
		1814
		1815	ecb_inline struct coro *
1623	coro_deq (pTHX)	1816	coro_deq (pTHX)
1624	{	1817	{
1625	int prio;	1818	int prio;
1626		1819
1627	for (prio = PRIO_MAX - PRIO_MIN + 1; --prio >= 0; )	1820	for (prio = CORO_PRIO_MAX - CORO_PRIO_MIN + 1; --prio >= 0; )
1628	if (AvFILLp (coro_ready [prio]) >= 0)	1821	{
1629	return av_shift (coro_ready [prio]);	1822	struct coro **ready = coro_ready [prio];
		1823
		1824	if (ready [0])
		1825	{
		1826	struct coro *coro = ready [0];
		1827	ready [0] = coro->next_ready;
		1828	return coro;
		1829	}
		1830	}
1630		1831
1631	return 0;	1832	return 0;
		1833	}
		1834
		1835	static void
		1836	invoke_sv_ready_hook_helper (void)
		1837	{
		1838	dTHX;
		1839	dSP;
		1840
		1841	ENTER;
		1842	SAVETMPS;
		1843
		1844	PUSHMARK (SP);
		1845	PUTBACK;
		1846	call_sv (coro_readyhook, G_VOID | G_DISCARD);
		1847
		1848	FREETMPS;
		1849	LEAVE;
1632	}	1850	}
1633		1851
1634	static int	1852	static int
1635	api_ready (pTHX_ SV *coro_sv)	1853	api_ready (pTHX_ SV *coro_sv)
1636	{	1854	{
1637	struct coro *coro;
1638	SV *sv_hook;
1639	void (*xs_hook)(void);
1640
1641	coro = SvSTATE (coro_sv);	1855	struct coro *coro = SvSTATE (coro_sv);
1642		1856
1643	if (coro->flags & CF_READY)	1857	if (coro->flags & CF_READY)
1644	return 0;	1858	return 0;
1645		1859
1646	coro->flags |= CF_READY;	1860	coro->flags |= CF_READY;
1647		1861
1648	sv_hook = coro_nready ? 0 : coro_readyhook;
1649	xs_hook = coro_nready ? 0 : coroapi.readyhook;
1650
1651	coro_enq (aTHX_ coro);	1862	coro_enq (aTHX_ coro);
1652	++coro_nready;
1653		1863
1654	if (sv_hook)	1864	if (!coro_nready++)
1655	{	1865	if (coroapi.readyhook)
1656	dSP;	1866	coroapi.readyhook ();
1657
1658	ENTER;
1659	SAVETMPS;
1660
1661	PUSHMARK (SP);
1662	PUTBACK;
1663	call_sv (sv_hook, G_VOID | G_DISCARD);
1664
1665	FREETMPS;
1666	LEAVE;
1667	}
1668
1669	if (xs_hook)
1670	xs_hook ();
1671		1867
1672	return 1;	1868	return 1;
1673	}	1869	}
1674		1870
1675	static int	1871	static int
…		…
1677	{	1873	{
1678	return !!(SvSTATE (coro_sv)->flags & CF_READY);	1874	return !!(SvSTATE (coro_sv)->flags & CF_READY);
1679	}	1875	}
1680		1876
1681	/* expects to own a reference to next->hv */	1877	/* expects to own a reference to next->hv */
1682	INLINE void	1878	ecb_inline void
1683	prepare_schedule_to (pTHX_ struct coro_transfer_args *ta, struct coro *next)	1879	prepare_schedule_to (pTHX_ struct coro_transfer_args *ta, struct coro *next)
1684	{	1880	{
1685	SV *prev_sv = SvRV (coro_current);	1881	SV *prev_sv = SvRV (coro_current);
1686		1882
1687	ta->prev = SvSTATE_hv (prev_sv);	1883	ta->prev = SvSTATE_hv (prev_sv);
…		…
1698	static void	1894	static void
1699	prepare_schedule (pTHX_ struct coro_transfer_args *ta)	1895	prepare_schedule (pTHX_ struct coro_transfer_args *ta)
1700	{	1896	{
1701	for (;;)	1897	for (;;)
1702	{	1898	{
1703	SV *next_sv = coro_deq (aTHX);	1899	struct coro *next = coro_deq (aTHX);
1704		1900
1705	if (expect_true (next_sv))	1901	if (ecb_expect_true (next))
1706	{	1902	{
1707	struct coro *next = SvSTATE_hv (next_sv);
1708
1709	/* cannot transfer to destroyed coros, skip and look for next */	1903	/* cannot transfer to destroyed coros, skip and look for next */
1710	if (expect_false (next->flags & CF_DESTROYED))	1904	if (ecb_expect_false (next->flags & (CF_ZOMBIE | CF_SUSPENDED)))
1711	SvREFCNT_dec (next_sv); /* coro_nready has already been taken care of by destroy */	1905	SvREFCNT_dec (next->hv); /* coro_nready has already been taken care of by destroy */
1712	else	1906	else
1713	{	1907	{
1714	next->flags &= ~CF_READY;	1908	next->flags &= ~CF_READY;
1715	--coro_nready;	1909	--coro_nready;
1716		1910
…		…
1722	{	1916	{
1723	/* nothing to schedule: call the idle handler */	1917	/* nothing to schedule: call the idle handler */
1724	if (SvROK (sv_idle)	1918	if (SvROK (sv_idle)
1725	&& SvOBJECT (SvRV (sv_idle)))	1919	&& SvOBJECT (SvRV (sv_idle)))
1726	{	1920	{
		1921	if (SvRV (sv_idle) == SvRV (coro_current))
		1922	{
		1923	require_pv ("Carp");
		1924
		1925	{
		1926	dSP;
		1927
		1928	ENTER;
		1929	SAVETMPS;
		1930
		1931	PUSHMARK (SP);
		1932	XPUSHs (sv_2mortal (newSVpv ("FATAL: $Coro::IDLE blocked itself - did you try to block inside an event loop callback? Caught", 0)));
		1933	PUTBACK;
		1934	call_pv ("Carp::confess", G_VOID | G_DISCARD);
		1935
		1936	FREETMPS;
		1937	LEAVE;
		1938	}
		1939	}
		1940
1727	++coro_nready; /* hack so that api_ready doesn't invoke ready hook */	1941	++coro_nready; /* hack so that api_ready doesn't invoke ready hook */
1728	api_ready (aTHX_ SvRV (sv_idle));	1942	api_ready (aTHX_ SvRV (sv_idle));
1729	--coro_nready;	1943	--coro_nready;
1730	}	1944	}
1731	else	1945	else
1732	{	1946	{
		1947	/* TODO: deprecated, remove, cannot work reliably *//*D*/
1733	dSP;	1948	dSP;
1734		1949
1735	ENTER;	1950	ENTER;
1736	SAVETMPS;	1951	SAVETMPS;
1737		1952
…		…
1744	}	1959	}
1745	}	1960	}
1746	}	1961	}
1747	}	1962	}
1748		1963
1749	INLINE void	1964	ecb_inline void
1750	prepare_cede (pTHX_ struct coro_transfer_args *ta)	1965	prepare_cede (pTHX_ struct coro_transfer_args *ta)
1751	{	1966	{
1752	api_ready (aTHX_ coro_current);	1967	api_ready (aTHX_ coro_current);
1753	prepare_schedule (aTHX_ ta);	1968	prepare_schedule (aTHX_ ta);
1754	}	1969	}
1755		1970
1756	INLINE void	1971	ecb_inline void
1757	prepare_cede_notself (pTHX_ struct coro_transfer_args *ta)	1972	prepare_cede_notself (pTHX_ struct coro_transfer_args *ta)
1758	{	1973	{
1759	SV *prev = SvRV (coro_current);	1974	SV *prev = SvRV (coro_current);
1760		1975
1761	if (coro_nready)	1976	if (coro_nready)
…		…
1791	{	2006	{
1792	struct coro_transfer_args ta;	2007	struct coro_transfer_args ta;
1793		2008
1794	prepare_cede (aTHX_ &ta);	2009	prepare_cede (aTHX_ &ta);
1795		2010
1796	if (expect_true (ta.prev != ta.next))	2011	if (ecb_expect_true (ta.prev != ta.next))
1797	{	2012	{
1798	TRANSFER (ta, 1);	2013	TRANSFER (ta, 1);
1799	return 1;	2014	return 1;
1800	}	2015	}
1801	else	2016	else
…		…
1844	coro->slot->runops = RUNOPS_DEFAULT;	2059	coro->slot->runops = RUNOPS_DEFAULT;
1845	}	2060	}
1846	}	2061	}
1847		2062
1848	static void	2063	static void
		2064	coro_push_av (pTHX_ AV *av, I32 gimme_v)
		2065	{
		2066	if (AvFILLp (av) >= 0 && gimme_v != G_VOID)
		2067	{
		2068	dSP;
		2069
		2070	if (gimme_v == G_SCALAR)
		2071	XPUSHs (AvARRAY (av)[AvFILLp (av)]);
		2072	else
		2073	{
		2074	int i;
		2075	EXTEND (SP, AvFILLp (av) + 1);
		2076
		2077	for (i = 0; i <= AvFILLp (av); ++i)
		2078	PUSHs (AvARRAY (av)[i]);
		2079	}
		2080
		2081	PUTBACK;
		2082	}
		2083	}
		2084
		2085	static void
		2086	coro_push_on_destroy (pTHX_ struct coro *coro, SV *cb)
		2087	{
		2088	if (!coro->on_destroy)
		2089	coro->on_destroy = newAV ();
		2090
		2091	av_push (coro->on_destroy, cb);
		2092	}
		2093
		2094	static void
		2095	slf_destroy_join (pTHX_ struct CoroSLF *frame)
		2096	{
		2097	SvREFCNT_dec ((SV *)((struct coro *)frame->data)->hv);
		2098	}
		2099
		2100	static int
		2101	slf_check_join (pTHX_ struct CoroSLF *frame)
		2102	{
		2103	struct coro *coro = (struct coro *)frame->data;
		2104
		2105	if (!coro->status)
		2106	return 1;
		2107
		2108	frame->destroy = 0;
		2109
		2110	coro_push_av (aTHX_ coro->status, GIMME_V);
		2111
		2112	SvREFCNT_dec ((SV *)coro->hv);
		2113
		2114	return 0;
		2115	}
		2116
		2117	static void
		2118	slf_init_join (pTHX_ struct CoroSLF *frame, CV *cv, SV **arg, int items)
		2119	{
		2120	struct coro *coro = SvSTATE (items > 0 ? arg [0] : &PL_sv_undef);
		2121
		2122	if (items > 1)
		2123	croak ("join called with too many arguments");
		2124
		2125	if (coro->status)
		2126	frame->prepare = prepare_nop;
		2127	else
		2128	{
		2129	coro_push_on_destroy (aTHX_ coro, SvREFCNT_inc_NN (SvRV (coro_current)));
		2130	frame->prepare = prepare_schedule;
		2131	}
		2132
		2133	frame->check = slf_check_join;
		2134	frame->destroy = slf_destroy_join;
		2135	frame->data = (void *)coro;
		2136	SvREFCNT_inc (coro->hv);
		2137	}
		2138
		2139	static void
1849	coro_call_on_destroy (pTHX_ struct coro *coro)	2140	coro_call_on_destroy (pTHX_ struct coro *coro)
1850	{	2141	{
1851	SV **on_destroyp = hv_fetch (coro->hv, "_on_destroy", sizeof ("_on_destroy") - 1, 0);	2142	AV *od = coro->on_destroy;
1852	SV **statusp = hv_fetch (coro->hv, "_status", sizeof ("_status") - 1, 0);
1853		2143
1854	if (on_destroyp)	2144	if (!od)
1855	{	2145	return;
1856	AV *on_destroy = (AV *)SvRV (*on_destroyp);
1857		2146
		2147	coro->on_destroy = 0;
		2148	sv_2mortal ((SV *)od);
		2149
1858	while (AvFILLp (on_destroy) >= 0)	2150	while (AvFILLp (od) >= 0)
		2151	{
		2152	SV *cb = sv_2mortal (av_pop (od));
		2153
		2154	/* coro hv's (and only hv's at the moment) are supported as well */
		2155	if (SvSTATEhv_p (aTHX_ cb))
		2156	api_ready (aTHX_ cb);
		2157	else
1859	{	2158	{
1860	dSP; /* don't disturb outer sp */	2159	dSP; /* don't disturb outer sp */
1861	SV *cb = av_pop (on_destroy);
1862
1863	PUSHMARK (SP);	2160	PUSHMARK (SP);
1864		2161
1865	if (statusp)	2162	if (coro->status)
1866	{	2163	{
1867	int i;	2164	PUTBACK;
1868	AV *status = (AV *)SvRV (*statusp);	2165	coro_push_av (aTHX_ coro->status, G_ARRAY);
1869	EXTEND (SP, AvFILLp (status) + 1);	2166	SPAGAIN;
1870
1871	for (i = 0; i <= AvFILLp (status); ++i)
1872	PUSHs (AvARRAY (status)[i]);
1873	}	2167	}
1874		2168
1875	PUTBACK;	2169	PUTBACK;
1876	call_sv (sv_2mortal (cb), G_VOID | G_DISCARD);	2170	call_sv (cb, G_VOID | G_DISCARD);
1877	}	2171	}
1878	}	2172	}
1879	}	2173	}
1880		2174
1881	static void	2175	static void
1882	slf_init_terminate (pTHX_ struct CoroSLF *frame, CV *cv, SV **arg, int items)	2176	coro_set_status (pTHX_ struct coro *coro, SV **arg, int items)
1883	{	2177	{
		2178	AV *av;
		2179
		2180	if (coro->status)
		2181	{
		2182	av = coro->status;
		2183	av_clear (av);
		2184	}
		2185	else
		2186	av = coro->status = newAV ();
		2187
		2188	/* items are actually not so common, so optimise for this case */
		2189	if (items)
		2190	{
1884	int i;	2191	int i;
1885	HV *hv = (HV *)SvRV (coro_current);
1886	AV *av = newAV ();
1887		2192
1888	av_extend (av, items - 1);	2193	av_extend (av, items - 1);
		2194
1889	for (i = 0; i < items; ++i)	2195	for (i = 0; i < items; ++i)
1890	av_push (av, SvREFCNT_inc_NN (arg [i]));	2196	av_push (av, SvREFCNT_inc_NN (arg [i]));
		2197	}
		2198	}
1891		2199
1892	hv_store (hv, "_status", sizeof ("_status") - 1, newRV_noinc ((SV *)av), 0);	2200	static void
1893		2201	slf_init_terminate_cancel_common (pTHX_ struct CoroSLF *frame, HV *coro_hv)
		2202	{
1894	av_push (av_destroy, (SV *)newRV_inc ((SV *)hv)); /* RVinc for perl */	2203	av_push (av_destroy, (SV *)newRV_inc ((SV *)coro_hv)); /* RVinc for perl */
1895	api_ready (aTHX_ sv_manager);	2204	api_ready (aTHX_ sv_manager);
1896		2205
1897	frame->prepare = prepare_schedule;	2206	frame->prepare = prepare_schedule;
1898	frame->check = slf_check_repeat;	2207	frame->check = slf_check_repeat;
1899		2208
1900	/* as a minor optimisation, we could unwind all stacks here */	2209	/* as a minor optimisation, we could unwind all stacks here */
1901	/* but that puts extra pressure on pp_slf, and is not worth much */	2210	/* but that puts extra pressure on pp_slf, and is not worth much */
1902	/*coro_unwind_stacks (aTHX);*/	2211	/*coro_unwind_stacks (aTHX);*/
		2212	}
		2213
		2214	static void
		2215	slf_init_terminate (pTHX_ struct CoroSLF *frame, CV *cv, SV **arg, int items)
		2216	{
		2217	HV *coro_hv = (HV *)SvRV (coro_current);
		2218
		2219	coro_set_status (aTHX_ SvSTATE ((SV *)coro_hv), arg, items);
		2220	slf_init_terminate_cancel_common (aTHX_ frame, coro_hv);
		2221	}
		2222
		2223	static void
		2224	slf_init_cancel (pTHX_ struct CoroSLF *frame, CV *cv, SV **arg, int items)
		2225	{
		2226	HV *coro_hv;
		2227	struct coro *coro;
		2228
		2229	if (items <= 0)
		2230	croak ("Coro::cancel called without coro object,");
		2231
		2232	coro = SvSTATE (arg [0]);
		2233	coro_hv = coro->hv;
		2234
		2235	coro_set_status (aTHX_ coro, arg + 1, items - 1);
		2236
		2237	if (ecb_expect_false (coro->flags & CF_NOCANCEL))
		2238	{
		2239	/* coro currently busy cancelling something, so just notify it */
		2240	coro->slf_frame.data = (void *)coro;
		2241
		2242	frame->prepare = prepare_nop;
		2243	frame->check = slf_check_nop;
		2244	}
		2245	else if (coro_hv == (HV *)SvRV (coro_current))
		2246	{
		2247	/* cancelling the current coro is allowed, and equals terminate */
		2248	slf_init_terminate_cancel_common (aTHX_ frame, coro_hv);
		2249	}
		2250	else
		2251	{
		2252	struct coro *self = SvSTATE_current;
		2253
		2254	if (!self)
		2255	croak ("Coro::cancel called outside of thread content,");
		2256
		2257	/* otherwise we cancel directly, purely for speed reasons
		2258	* unfortunately, this requires some magic trickery, as
		2259	* somebody else could cancel us, so we have to fight the cancellation.
		2260	* this is ugly, and hopefully fully worth the extra speed.
		2261	* besides, I can't get the slow-but-safe version working...
		2262	*/
		2263	slf_frame.data = 0;
		2264	self->flags |= CF_NOCANCEL;
		2265	coro_state_destroy (aTHX_ coro);
		2266	self->flags &= ~CF_NOCANCEL;
		2267
		2268	if (slf_frame.data)
		2269	{
		2270	/* while we were busy we have been cancelled, so terminate */
		2271	slf_init_terminate_cancel_common (aTHX_ frame, self->hv);
		2272	}
		2273	else
		2274	{
		2275	frame->prepare = prepare_nop;
		2276	frame->check = slf_check_nop;
		2277	}
		2278	}
		2279	}
		2280
		2281	static int
		2282	slf_check_safe_cancel (pTHX_ struct CoroSLF *frame)
		2283	{
		2284	frame->prepare = 0;
		2285	coro_unwind_stacks (aTHX);
		2286
		2287	slf_init_terminate_cancel_common (aTHX_ frame, (HV *)SvRV (coro_current));
		2288
		2289	return 1;
		2290	}
		2291
		2292	static int
		2293	safe_cancel (pTHX_ struct coro *coro, SV **arg, int items)
		2294	{
		2295	if (coro->cctx)
		2296	croak ("coro inside C callback, unable to cancel at this time, caught");
		2297
		2298	if (coro->flags & CF_NEW)
		2299	{
		2300	coro_set_status (aTHX_ coro, arg, items);
		2301	coro_state_destroy (aTHX_ coro);
		2302	}
		2303	else
		2304	{
		2305	if (!coro->slf_frame.prepare)
		2306	croak ("coro outside an SLF function, unable to cancel at this time, caught");
		2307
		2308	slf_destroy (aTHX_ coro);
		2309
		2310	coro_set_status (aTHX_ coro, arg, items);
		2311	coro->slf_frame.prepare = prepare_nop;
		2312	coro->slf_frame.check = slf_check_safe_cancel;
		2313
		2314	api_ready (aTHX_ (SV *)coro->hv);
		2315	}
		2316
		2317	return 1;
1903	}	2318	}
1904		2319
1905	/*****************************************************************************/	2320	/*****************************************************************************/
1906	/* async pool handler */	2321	/* async pool handler */
1907		2322
…		…
1938	slf_init_pool_handler (pTHX_ struct CoroSLF *frame, CV *cv, SV **arg, int items)	2353	slf_init_pool_handler (pTHX_ struct CoroSLF *frame, CV *cv, SV **arg, int items)
1939	{	2354	{
1940	HV *hv = (HV *)SvRV (coro_current);	2355	HV *hv = (HV *)SvRV (coro_current);
1941	struct coro *coro = SvSTATE_hv ((SV *)hv);	2356	struct coro *coro = SvSTATE_hv ((SV *)hv);
1942		2357
1943	if (expect_true (coro->saved_deffh))	2358	if (ecb_expect_true (coro->saved_deffh))
1944	{	2359	{
1945	/* subsequent iteration */	2360	/* subsequent iteration */
1946	SvREFCNT_dec ((SV *)PL_defoutgv); PL_defoutgv = (GV *)coro->saved_deffh;	2361	SvREFCNT_dec ((SV *)PL_defoutgv); PL_defoutgv = (GV *)coro->saved_deffh;
1947	coro->saved_deffh = 0;	2362	coro->saved_deffh = 0;
1948		2363
1949	if (coro_rss (aTHX_ coro) > SvUV (sv_pool_rss)	2364	if (coro_rss (aTHX_ coro) > SvUV (sv_pool_rss)
1950	|| av_len (av_async_pool) + 1 >= SvIV (sv_pool_size))	2365	|| av_len (av_async_pool) + 1 >= SvIV (sv_pool_size))
1951	{	2366	{
1952	coro->invoke_cb = SvREFCNT_inc_NN ((SV *)cv_coro_terminate);	2367	slf_init_terminate_cancel_common (aTHX_ frame, hv);
1953	coro->invoke_av = newAV ();	2368	return;
1954
1955	frame->prepare = prepare_nop;
1956	}	2369	}
1957	else	2370	else
1958	{	2371	{
1959	av_clear (GvAV (PL_defgv));	2372	av_clear (GvAV (PL_defgv));
1960	hv_store (hv, "desc", sizeof ("desc") - 1, SvREFCNT_inc_NN (sv_async_pool_idle), 0);	2373	hv_store (hv, "desc", sizeof ("desc") - 1, SvREFCNT_inc_NN (sv_async_pool_idle), 0);
…		…
1985		2398
1986	static void	2399	static void
1987	coro_rouse_callback (pTHX_ CV *cv)	2400	coro_rouse_callback (pTHX_ CV *cv)
1988	{	2401	{
1989	dXSARGS;	2402	dXSARGS;
1990	SV *data = (SV *)GENSUB_ARG;	2403	SV *data = (SV *)S_GENSUB_ARG;
1991		2404
1992	if (SvTYPE (SvRV (data)) != SVt_PVAV)	2405	if (SvTYPE (SvRV (data)) != SVt_PVAV)
1993	{	2406	{
1994	/* first call, set args */	2407	/* first call, set args */
		2408	SV *coro = SvRV (data);
1995	AV *av = newAV ();	2409	AV *av = newAV ();
1996	SV *coro = SvRV (data);
1997		2410
1998	SvRV_set (data, (SV *)av);	2411	SvRV_set (data, (SV *)av);
1999	api_ready (aTHX_ coro);
2000	SvREFCNT_dec (coro);
2001		2412
2002	/* better take a full copy of the arguments */	2413	/* better take a full copy of the arguments */
2003	while (items--)	2414	while (items--)
2004	av_store (av, items, newSVsv (ST (items)));	2415	av_store (av, items, newSVsv (ST (items)));
		2416
		2417	api_ready (aTHX_ coro);
		2418	SvREFCNT_dec (coro);
2005	}	2419	}
2006		2420
2007	XSRETURN_EMPTY;	2421	XSRETURN_EMPTY;
2008	}	2422	}
2009		2423
2010	static int	2424	static int
2011	slf_check_rouse_wait (pTHX_ struct CoroSLF *frame)	2425	slf_check_rouse_wait (pTHX_ struct CoroSLF *frame)
2012	{	2426	{
2013	SV *data = (SV *)frame->data;	2427	SV *data = (SV *)frame->data;
2014		2428
2015	if (CORO_THROW)	2429	if (CORO_THROW)
2016	return 0;	2430	return 0;
2017		2431
2018	if (SvTYPE (SvRV (data)) != SVt_PVAV)	2432	if (SvTYPE (SvRV (data)) != SVt_PVAV)
2019	return 1;	2433	return 1;
…		…
2026		2440
2027	EXTEND (SP, AvFILLp (av) + 1);	2441	EXTEND (SP, AvFILLp (av) + 1);
2028	for (i = 0; i <= AvFILLp (av); ++i)	2442	for (i = 0; i <= AvFILLp (av); ++i)
2029	PUSHs (sv_2mortal (AvARRAY (av)[i]));	2443	PUSHs (sv_2mortal (AvARRAY (av)[i]));
2030		2444
2031	/* we have stolen the elements, so ste length to zero and free */	2445	/* we have stolen the elements, so set length to zero and free */
2032	AvFILLp (av) = -1;	2446	AvFILLp (av) = -1;
2033	av_undef (av);	2447	av_undef (av);
2034		2448
2035	PUTBACK;	2449	PUTBACK;
2036	}	2450	}
…		…
2055	cb = sv_2mortal (coro->rouse_cb);	2469	cb = sv_2mortal (coro->rouse_cb);
2056	coro->rouse_cb = 0;	2470	coro->rouse_cb = 0;
2057	}	2471	}
2058		2472
2059	if (!SvROK (cb)	2473	if (!SvROK (cb)
2060	|| SvTYPE (SvRV (cb)) != SVt_PVCV	2474	|| SvTYPE (SvRV (cb)) != SVt_PVCV
2061	|| CvXSUB ((CV *)SvRV (cb)) != coro_rouse_callback)	2475	|| CvXSUB ((CV *)SvRV (cb)) != coro_rouse_callback)
2062	croak ("Coro::rouse_wait called with illegal callback argument,");	2476	croak ("Coro::rouse_wait called with illegal callback argument,");
2063		2477
2064	{	2478	{
2065	CV *cv = (CV *)SvRV (cb); /* for GENSUB_ARG */	2479	CV *cv = (CV *)SvRV (cb); /* for S_GENSUB_ARG */
2066	SV *data = (SV *)GENSUB_ARG;	2480	SV *data = (SV *)S_GENSUB_ARG;
2067		2481
2068	frame->data = (void *)data;	2482	frame->data = (void *)data;
2069	frame->prepare = SvTYPE (SvRV (data)) == SVt_PVAV ? prepare_nop : prepare_schedule;	2483	frame->prepare = SvTYPE (SvRV (data)) == SVt_PVAV ? prepare_nop : prepare_schedule;
2070	frame->check = slf_check_rouse_wait;	2484	frame->check = slf_check_rouse_wait;
2071	}	2485	}
…		…
2075	coro_new_rouse_cb (pTHX)	2489	coro_new_rouse_cb (pTHX)
2076	{	2490	{
2077	HV *hv = (HV *)SvRV (coro_current);	2491	HV *hv = (HV *)SvRV (coro_current);
2078	struct coro *coro = SvSTATE_hv (hv);	2492	struct coro *coro = SvSTATE_hv (hv);
2079	SV *data = newRV_inc ((SV *)hv);	2493	SV *data = newRV_inc ((SV *)hv);
2080	SV *cb = gensub (aTHX_ coro_rouse_callback, (void *)data);	2494	SV *cb = s_gensub (aTHX_ coro_rouse_callback, (void *)data);
2081		2495
2082	sv_magicext (SvRV (cb), data, CORO_MAGIC_type_rouse, 0, 0, 0);	2496	sv_magicext (SvRV (cb), data, CORO_MAGIC_type_rouse, 0, 0, 0);
2083	SvREFCNT_dec (data); /* magicext increases the refcount */	2497	SvREFCNT_dec (data); /* magicext increases the refcount */
2084		2498
2085	SvREFCNT_dec (coro->rouse_cb);	2499	SvREFCNT_dec (coro->rouse_cb);
…		…
2182	static void	2596	static void
2183	slf_init_cede_notself (pTHX_ struct CoroSLF *frame, CV *cv, SV **arg, int items)	2597	slf_init_cede_notself (pTHX_ struct CoroSLF *frame, CV *cv, SV **arg, int items)
2184	{	2598	{
2185	frame->prepare = prepare_cede_notself;	2599	frame->prepare = prepare_cede_notself;
2186	frame->check = slf_check_nop;	2600	frame->check = slf_check_nop;
		2601	}
		2602
		2603	/* "undo"/cancel a running slf call - used when cancelling a coro, mainly */
		2604	static void
		2605	slf_destroy (pTHX_ struct coro *coro)
		2606	{
		2607	struct CoroSLF frame = coro->slf_frame;
		2608
		2609	/*
		2610	* The on_destroy below most likely is from an SLF call.
		2611	* Since by definition the SLF call will not finish when we destroy
		2612	* the coro, we will have to force-finish it here, otherwise
		2613	* cleanup functions cannot call SLF functions.
		2614	*/
		2615	coro->slf_frame.prepare = 0;
		2616
		2617	/* this callback is reserved for slf functions needing to do cleanup */
		2618	if (frame.destroy && frame.prepare && !PL_dirty)
		2619	frame.destroy (aTHX_ &frame);
2187	}	2620	}
2188		2621
2189	/*	2622	/*
2190	* these not obviously related functions are all rolled into one	2623	* these not obviously related functions are all rolled into one
2191	* function to increase chances that they all will call transfer with the same	2624	* function to increase chances that they all will call transfer with the same
…		…
2198	I32 checkmark; /* mark SP to see how many elements check has pushed */	2631	I32 checkmark; /* mark SP to see how many elements check has pushed */
2199		2632
2200	/* set up the slf frame, unless it has already been set-up */	2633	/* set up the slf frame, unless it has already been set-up */
2201	/* the latter happens when a new coro has been started */	2634	/* the latter happens when a new coro has been started */
2202	/* or when a new cctx was attached to an existing coroutine */	2635	/* or when a new cctx was attached to an existing coroutine */
2203	if (expect_true (!slf_frame.prepare))	2636	if (ecb_expect_true (!slf_frame.prepare))
2204	{	2637	{
2205	/* first iteration */	2638	/* first iteration */
2206	dSP;	2639	dSP;
2207	SV **arg = PL_stack_base + TOPMARK + 1;	2640	SV **arg = PL_stack_base + TOPMARK + 1;
2208	int items = SP - arg; /* args without function object */	2641	int items = SP - arg; /* args without function object */
…		…
2249	while (slf_frame.check (aTHX_ &slf_frame));	2682	while (slf_frame.check (aTHX_ &slf_frame));
2250		2683
2251	slf_frame.prepare = 0; /* invalidate the frame, we are done processing it */	2684	slf_frame.prepare = 0; /* invalidate the frame, we are done processing it */
2252		2685
2253	/* exception handling */	2686	/* exception handling */
2254	if (expect_false (CORO_THROW))	2687	if (ecb_expect_false (CORO_THROW))
2255	{	2688	{
2256	SV *exception = sv_2mortal (CORO_THROW);	2689	SV *exception = sv_2mortal (CORO_THROW);
2257		2690
2258	CORO_THROW = 0;	2691	CORO_THROW = 0;
2259	sv_setsv (ERRSV, exception);	2692	sv_setsv (ERRSV, exception);
2260	croak (0);	2693	croak (0);
2261	}	2694	}
2262		2695
2263	/* return value handling - mostly like entersub */	2696	/* return value handling - mostly like entersub */
2264	/* make sure we put something on the stack in scalar context */	2697	/* make sure we put something on the stack in scalar context */
2265	if (GIMME_V == G_SCALAR)	2698	if (GIMME_V == G_SCALAR
		2699	&& ecb_expect_false (PL_stack_sp != PL_stack_base + checkmark + 1))
2266	{	2700	{
2267	dSP;	2701	dSP;
2268	SV **bot = PL_stack_base + checkmark;	2702	SV **bot = PL_stack_base + checkmark;
2269		2703
2270	if (sp == bot) /* too few, push undef */	2704	if (sp == bot) /* too few, push undef */
2271	bot [1] = &PL_sv_undef;	2705	bot [1] = &PL_sv_undef;
2272	else if (sp != bot + 1) /* too many, take last one */	2706	else /* too many, take last one */
2273	bot [1] = *sp;	2707	bot [1] = *sp;
2274		2708
2275	SP = bot + 1;	2709	SP = bot + 1;
2276		2710
2277	PUTBACK;	2711	PUTBACK;
…		…
2310	if (PL_op->op_flags & OPf_STACKED)	2744	if (PL_op->op_flags & OPf_STACKED)
2311	{	2745	{
2312	if (items > slf_arga)	2746	if (items > slf_arga)
2313	{	2747	{
2314	slf_arga = items;	2748	slf_arga = items;
2315	free (slf_argv);	2749	Safefree (slf_argv);
2316	slf_argv = malloc (slf_arga * sizeof (SV *));	2750	New (0, slf_argv, slf_arga, SV *);
2317	}	2751	}
2318		2752
2319	slf_argc = items;	2753	slf_argc = items;
2320		2754
2321	for (i = 0; i < items; ++i)	2755	for (i = 0; i < items; ++i)
…		…
2347		2781
2348	POPSTACK;	2782	POPSTACK;
2349	}	2783	}
2350		2784
2351	static SV *	2785	static SV *
2352	coro_avp_pop_and_free (AV **avp)	2786	coro_avp_pop_and_free (pTHX_ AV **avp)
2353	{	2787	{
2354	AV *av = *avp;	2788	AV *av = *avp;
2355	SV *res = av_pop (av);	2789	SV *res = av_pop (av);
2356		2790
2357	if (AvFILLp (av) < 0)	2791	if (AvFILLp (av) < 0)
…		…
2364	}	2798	}
2365		2799
2366	static void	2800	static void
2367	coro_pop_on_enter (pTHX_ void *coro)	2801	coro_pop_on_enter (pTHX_ void *coro)
2368	{	2802	{
2369	SV *cb = coro_avp_pop_and_free (&((struct coro *)coro)->on_enter);	2803	SV *cb = coro_avp_pop_and_free (aTHX_ &((struct coro *)coro)->on_enter);
2370	SvREFCNT_dec (cb);	2804	SvREFCNT_dec (cb);
2371	}	2805	}
2372		2806
2373	static void	2807	static void
2374	coro_pop_on_leave (pTHX_ void *coro)	2808	coro_pop_on_leave (pTHX_ void *coro)
2375	{	2809	{
2376	SV *cb = coro_avp_pop_and_free (&((struct coro *)coro)->on_leave);	2810	SV *cb = coro_avp_pop_and_free (aTHX_ &((struct coro *)coro)->on_leave);
2377	on_enterleave_call (sv_2mortal (cb));	2811	on_enterleave_call (aTHX_ sv_2mortal (cb));
2378	}	2812	}
2379		2813
2380	/*****************************************************************************/	2814	/*****************************************************************************/
2381	/* PerlIO::cede */	2815	/* PerlIO::cede */
2382		2816
…		…
2384	{	2818	{
2385	PerlIOBuf base;	2819	PerlIOBuf base;
2386	NV next, every;	2820	NV next, every;
2387	} PerlIOCede;	2821	} PerlIOCede;
2388		2822
2389	static IV	2823	static IV ecb_cold
2390	PerlIOCede_pushed (pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab)	2824	PerlIOCede_pushed (pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab)
2391	{	2825	{
2392	PerlIOCede *self = PerlIOSelf (f, PerlIOCede);	2826	PerlIOCede *self = PerlIOSelf (f, PerlIOCede);
2393		2827
2394	self->every = SvCUR (arg) ? SvNV (arg) : 0.01;	2828	self->every = SvCUR (arg) ? SvNV (arg) : 0.01;
2395	self->next = nvtime () + self->every;	2829	self->next = nvtime () + self->every;
2396		2830
2397	return PerlIOBuf_pushed (aTHX_ f, mode, Nullsv, tab);	2831	return PerlIOBuf_pushed (aTHX_ f, mode, Nullsv, tab);
2398	}	2832	}
2399		2833
2400	static SV *	2834	static SV * ecb_cold
2401	PerlIOCede_getarg (pTHX_ PerlIO *f, CLONE_PARAMS *param, int flags)	2835	PerlIOCede_getarg (pTHX_ PerlIO *f, CLONE_PARAMS *param, int flags)
2402	{	2836	{
2403	PerlIOCede *self = PerlIOSelf (f, PerlIOCede);	2837	PerlIOCede *self = PerlIOSelf (f, PerlIOCede);
2404		2838
2405	return newSVnv (self->every);	2839	return newSVnv (self->every);
…		…
2456	/* Coro::Semaphore & Coro::Signal */	2890	/* Coro::Semaphore & Coro::Signal */
2457		2891
2458	static SV *	2892	static SV *
2459	coro_waitarray_new (pTHX_ int count)	2893	coro_waitarray_new (pTHX_ int count)
2460	{	2894	{
2461	/* a semaphore contains a counter IV in $sem->[0] and any waiters after that */	2895	/* a waitarray=semaphore contains a counter IV in $sem->[0] and any waiters after that */
2462	AV *av = newAV ();	2896	AV *av = newAV ();
2463	SV **ary;	2897	SV **ary;
2464		2898
2465	/* unfortunately, building manually saves memory */	2899	/* unfortunately, building manually saves memory */
2466	Newx (ary, 2, SV *);	2900	Newx (ary, 2, SV *);
…		…
2517	SvREFCNT_dec (cb);	2951	SvREFCNT_dec (cb);
2518	}	2952	}
2519	}	2953	}
2520		2954
2521	static void	2955	static void
2522	coro_semaphore_on_destroy (pTHX_ struct coro *coro)	2956	coro_semaphore_destroy (pTHX_ struct CoroSLF *frame)
2523	{	2957	{
2524	/* call $sem->adjust (0) to possibly wake up some other waiters */	2958	/* call $sem->adjust (0) to possibly wake up some other waiters */
2525	coro_semaphore_adjust (aTHX_ (AV *)coro->slf_frame.data, 0);	2959	coro_semaphore_adjust (aTHX_ (AV *)frame->data, 0);
2526	}	2960	}
2527		2961
2528	static int	2962	static int
2529	slf_check_semaphore_down_or_wait (pTHX_ struct CoroSLF *frame, int acquire)	2963	slf_check_semaphore_down_or_wait (pTHX_ struct CoroSLF *frame, int acquire)
2530	{	2964	{
2531	AV *av = (AV *)frame->data;	2965	AV *av = (AV *)frame->data;
2532	SV *count_sv = AvARRAY (av)[0];	2966	SV *count_sv = AvARRAY (av)[0];
		2967	SV *coro_hv = SvRV (coro_current);
		2968
		2969	frame->destroy = 0;
2533		2970
2534	/* if we are about to throw, don't actually acquire the lock, just throw */	2971	/* if we are about to throw, don't actually acquire the lock, just throw */
2535	if (CORO_THROW)	2972	if (ecb_expect_false (CORO_THROW))
		2973	{
		2974	/* we still might be responsible for the semaphore, so wake up others */
		2975	coro_semaphore_adjust (aTHX_ av, 0);
		2976
2536	return 0;	2977	return 0;
		2978	}
2537	else if (SvIVX (count_sv) > 0)	2979	else if (SvIVX (count_sv) > 0)
2538	{	2980	{
2539	SvSTATE_current->on_destroy = 0;
2540
2541	if (acquire)	2981	if (acquire)
2542	SvIVX (count_sv) = SvIVX (count_sv) - 1;	2982	SvIVX (count_sv) = SvIVX (count_sv) - 1;
2543	else	2983	else
2544	coro_semaphore_adjust (aTHX_ av, 0);	2984	coro_semaphore_adjust (aTHX_ av, 0);
2545		2985
…		…
2549	{	2989	{
2550	int i;	2990	int i;
2551	/* if we were woken up but can't down, we look through the whole */	2991	/* if we were woken up but can't down, we look through the whole */
2552	/* waiters list and only add us if we aren't in there already */	2992	/* waiters list and only add us if we aren't in there already */
2553	/* this avoids some degenerate memory usage cases */	2993	/* this avoids some degenerate memory usage cases */
2554		2994	for (i = AvFILLp (av); i > 0; --i) /* i > 0 is not an off-by-one bug */
2555	for (i = 1; i <= AvFILLp (av); ++i)
2556	if (AvARRAY (av)[i] == SvRV (coro_current))	2995	if (AvARRAY (av)[i] == coro_hv)
2557	return 1;	2996	return 1;
2558		2997
2559	av_push (av, SvREFCNT_inc (SvRV (coro_current)));	2998	av_push (av, SvREFCNT_inc (coro_hv));
2560	return 1;	2999	return 1;
2561	}	3000	}
2562	}	3001	}
2563		3002
2564	static int	3003	static int
…		…
2587	{	3026	{
2588	av_push (av, SvREFCNT_inc (SvRV (coro_current)));	3027	av_push (av, SvREFCNT_inc (SvRV (coro_current)));
2589		3028
2590	frame->data = (void *)sv_2mortal (SvREFCNT_inc ((SV *)av));	3029	frame->data = (void *)sv_2mortal (SvREFCNT_inc ((SV *)av));
2591	frame->prepare = prepare_schedule;	3030	frame->prepare = prepare_schedule;
2592
2593	/* to avoid race conditions when a woken-up coro gets terminated */	3031	/* to avoid race conditions when a woken-up coro gets terminated */
2594	/* we arrange for a temporary on_destroy that calls adjust (0) */	3032	/* we arrange for a temporary on_destroy that calls adjust (0) */
2595	SvSTATE_current->on_destroy = coro_semaphore_on_destroy;	3033	frame->destroy = coro_semaphore_destroy;
2596	}	3034	}
2597	}	3035	}
2598		3036
2599	static void	3037	static void
2600	slf_init_semaphore_down (pTHX_ struct CoroSLF *frame, CV *cv, SV **arg, int items)	3038	slf_init_semaphore_down (pTHX_ struct CoroSLF *frame, CV *cv, SV **arg, int items)
…		…
2608	{	3046	{
2609	if (items >= 2)	3047	if (items >= 2)
2610	{	3048	{
2611	/* callback form */	3049	/* callback form */
2612	AV *av = (AV *)SvRV (arg [0]);	3050	AV *av = (AV *)SvRV (arg [0]);
2613	CV *cb_cv = coro_sv_2cv (aTHX_ arg [1]);	3051	SV *cb_cv = s_get_cv_croak (arg [1]);
2614		3052
2615	av_push (av, (SV *)SvREFCNT_inc_NN (cb_cv));	3053	av_push (av, SvREFCNT_inc_NN (cb_cv));
2616		3054
2617	if (SvIVX (AvARRAY (av)[0]) > 0)	3055	if (SvIVX (AvARRAY (av)[0]) > 0)
2618	coro_semaphore_adjust (aTHX_ av, 0);	3056	coro_semaphore_adjust (aTHX_ av, 0);
2619		3057
2620	frame->prepare = prepare_nop;	3058	frame->prepare = prepare_nop;
…		…
2644	AvARRAY (av)[0] = AvARRAY (av)[1];	3082	AvARRAY (av)[0] = AvARRAY (av)[1];
2645	AvARRAY (av)[1] = cb;	3083	AvARRAY (av)[1] = cb;
2646		3084
2647	cb = av_shift (av);	3085	cb = av_shift (av);
2648		3086
		3087	if (SvTYPE (cb) == SVt_PVCV)
		3088	{
		3089	dSP;
		3090	PUSHMARK (SP);
		3091	XPUSHs (sv_2mortal (newRV_inc ((SV *)av)));
		3092	PUTBACK;
		3093	call_sv (cb, G_VOID | G_DISCARD | G_EVAL | G_KEEPERR);
		3094	}
		3095	else
		3096	{
2649	api_ready (aTHX_ cb);	3097	api_ready (aTHX_ cb);
2650	sv_setiv (cb, 0); /* signal waiter */	3098	sv_setiv (cb, 0); /* signal waiter */
		3099	}
		3100
2651	SvREFCNT_dec (cb);	3101	SvREFCNT_dec (cb);
2652		3102
2653	--count;	3103	--count;
2654	}	3104	}
2655	}	3105	}
…		…
2664	static void	3114	static void
2665	slf_init_signal_wait (pTHX_ struct CoroSLF *frame, CV *cv, SV **arg, int items)	3115	slf_init_signal_wait (pTHX_ struct CoroSLF *frame, CV *cv, SV **arg, int items)
2666	{	3116	{
2667	AV *av = (AV *)SvRV (arg [0]);	3117	AV *av = (AV *)SvRV (arg [0]);
2668		3118
		3119	if (items >= 2)
		3120	{
		3121	SV *cb_cv = s_get_cv_croak (arg [1]);
		3122	av_push (av, SvREFCNT_inc_NN (cb_cv));
		3123
2669	if (SvIVX (AvARRAY (av)[0]))	3124	if (SvIVX (AvARRAY (av)[0]))
		3125	coro_signal_wake (aTHX_ av, 1); /* must be the only waiter */
		3126
		3127	frame->prepare = prepare_nop;
		3128	frame->check = slf_check_nop;
		3129	}
		3130	else if (SvIVX (AvARRAY (av)[0]))
2670	{	3131	{
2671	SvIVX (AvARRAY (av)[0]) = 0;	3132	SvIVX (AvARRAY (av)[0]) = 0;
2672	frame->prepare = prepare_nop;	3133	frame->prepare = prepare_nop;
2673	frame->check = slf_check_nop;	3134	frame->check = slf_check_nop;
2674	}	3135	}
2675	else	3136	else
2676	{	3137	{
2677	SV *waiter = newRV_inc (SvRV (coro_current)); /* owned by signal av */	3138	SV *waiter = newSVsv (coro_current); /* owned by signal av */
2678		3139
2679	av_push (av, waiter);	3140	av_push (av, waiter);
2680		3141
2681	frame->data = (void *)sv_2mortal (SvREFCNT_inc_NN (waiter)); /* owned by process */	3142	frame->data = (void *)sv_2mortal (SvREFCNT_inc_NN (waiter)); /* owned by process */
2682	frame->prepare = prepare_schedule;	3143	frame->prepare = prepare_schedule;
…		…
2700		3161
2701	static void	3162	static void
2702	coro_aio_callback (pTHX_ CV *cv)	3163	coro_aio_callback (pTHX_ CV *cv)
2703	{	3164	{
2704	dXSARGS;	3165	dXSARGS;
2705	AV *state = (AV *)GENSUB_ARG;	3166	AV *state = (AV *)S_GENSUB_ARG;
2706	SV *coro = av_pop (state);	3167	SV *coro = av_pop (state);
2707	SV *data_sv = newSV (sizeof (struct io_state));	3168	SV *data_sv = newSV (sizeof (struct io_state));
2708		3169
2709	av_extend (state, items - 1);	3170	av_extend (state, items - 1);
2710		3171
…		…
2746	/* it quickly returns */	3207	/* it quickly returns */
2747	if (CORO_THROW)	3208	if (CORO_THROW)
2748	return 0;	3209	return 0;
2749		3210
2750	/* one element that is an RV? repeat! */	3211	/* one element that is an RV? repeat! */
2751	if (AvFILLp (state) == 0 && SvROK (AvARRAY (state)[0]))	3212	if (AvFILLp (state) == 0 && SvTYPE (AvARRAY (state)[0]) != SVt_PV)
2752	return 1;	3213	return 1;
2753		3214
2754	/* restore status */	3215	/* restore status */
2755	{	3216	{
2756	SV *data_sv = av_pop (state);	3217	SV *data_sv = av_pop (state);
…		…
2795	dSP;	3256	dSP;
2796		3257
2797	static SV *prio_cv;	3258	static SV *prio_cv;
2798	static SV *prio_sv;	3259	static SV *prio_sv;
2799		3260
2800	if (expect_false (!prio_cv))	3261	if (ecb_expect_false (!prio_cv))
2801	{	3262	{
2802	prio_cv = (SV *)get_cv ("IO::AIO::aioreq_pri", 0);	3263	prio_cv = (SV *)get_cv ("IO::AIO::aioreq_pri", 0);
2803	prio_sv = newSViv (0);	3264	prio_sv = newSViv (0);
2804	}	3265	}
2805		3266
…		…
2824		3285
2825	for (i = 0; i < items; ++i)	3286	for (i = 0; i < items; ++i)
2826	PUSHs (arg [i]);	3287	PUSHs (arg [i]);
2827		3288
2828	/* now push the callback closure */	3289	/* now push the callback closure */
2829	PUSHs (sv_2mortal (gensub (aTHX_ coro_aio_callback, (void *)SvREFCNT_inc_NN ((SV *)state))));	3290	PUSHs (sv_2mortal (s_gensub (aTHX_ coro_aio_callback, (void *)SvREFCNT_inc_NN ((SV *)state))));
2830		3291
2831	/* now call the AIO function - we assume our request is uncancelable */	3292	/* now call the AIO function - we assume our request is uncancelable */
2832	PUTBACK;	3293	PUTBACK;
2833	call_sv ((SV *)req, G_VOID | G_DISCARD);	3294	call_sv ((SV *)req, G_VOID | G_DISCARD);
2834	}	3295	}
2835		3296
2836	/* now that the requets is going, we loop toll we have a result */	3297	/* now that the request is going, we loop till we have a result */
2837	frame->data = (void *)state;	3298	frame->data = (void *)state;
2838	frame->prepare = prepare_schedule;	3299	frame->prepare = prepare_schedule;
2839	frame->check = slf_check_aio_req;	3300	frame->check = slf_check_aio_req;
2840	}	3301	}
2841		3302
…		…
2851		3312
2852	/*****************************************************************************/	3313	/*****************************************************************************/
2853		3314
2854	#if CORO_CLONE	3315	#if CORO_CLONE
2855	# include "clone.c"	3316	# include "clone.c"
		3317	#endif
		3318
		3319	/*****************************************************************************/
		3320
		3321	static SV *
		3322	coro_new (pTHX_ HV *stash, SV **argv, int argc, int is_coro)
		3323	{
		3324	SV *coro_sv;
		3325	struct coro *coro;
		3326	MAGIC *mg;
		3327	HV *hv;
		3328	SV *cb;
		3329	int i;
		3330
		3331	if (argc > 0)
		3332	{
		3333	cb = s_get_cv_croak (argv [0]);
		3334
		3335	if (!is_coro)
		3336	{
		3337	if (CvISXSUB (cb))
		3338	croak ("Coro::State doesn't support XS functions as coroutine start, caught");
		3339
		3340	if (!CvROOT (cb))
		3341	croak ("Coro::State doesn't support autoloaded or undefined functions as coroutine start, caught");
		3342	}
		3343	}
		3344
		3345	Newz (0, coro, 1, struct coro);
		3346	coro->args = newAV ();
		3347	coro->flags = CF_NEW;
		3348
		3349	if (coro_first) coro_first->prev = coro;
		3350	coro->next = coro_first;
		3351	coro_first = coro;
		3352
		3353	coro->hv = hv = newHV ();
		3354	mg = sv_magicext ((SV *)hv, 0, CORO_MAGIC_type_state, &coro_state_vtbl, (char *)coro, 0);
		3355	mg->mg_flags |= MGf_DUP;
		3356	coro_sv = sv_bless (newRV_noinc ((SV *)hv), stash);
		3357
		3358	if (argc > 0)
		3359	{
		3360	av_extend (coro->args, argc + is_coro - 1);
		3361
		3362	if (is_coro)
		3363	{
		3364	av_push (coro->args, SvREFCNT_inc_NN ((SV *)cb));
		3365	cb = (SV *)cv_coro_run;
		3366	}
		3367
		3368	coro->startcv = (CV *)SvREFCNT_inc_NN ((SV *)cb);
		3369
		3370	for (i = 1; i < argc; i++)
		3371	av_push (coro->args, newSVsv (argv [i]));
		3372	}
		3373
		3374	return coro_sv;
		3375	}
		3376
		3377	#ifndef __cplusplus
		3378	ecb_cold XS(boot_Coro__State);
		3379	#endif
		3380
		3381	#if CORO_JIT
		3382
		3383	static void ecb_noinline ecb_cold
		3384	pushav_4uv (pTHX_ UV a, UV b, UV c, UV d)
		3385	{
		3386	dSP;
		3387	AV *av = newAV ();
		3388
		3389	av_store (av, 3, newSVuv (d));
		3390	av_store (av, 2, newSVuv (c));
		3391	av_store (av, 1, newSVuv (b));
		3392	av_store (av, 0, newSVuv (a));
		3393
		3394	XPUSHs (sv_2mortal (newRV_noinc ((SV *)av)));
		3395
		3396	PUTBACK;
		3397	}
		3398
		3399	static void ecb_noinline ecb_cold
		3400	jit_init (pTHX)
		3401	{
		3402	dSP;
		3403	SV *load, *save;
		3404	char *map_base;
		3405	char *load_ptr, *save_ptr;
		3406	STRLEN load_len, save_len, map_len;
		3407	int count;
		3408
		3409	eval_pv ("require 'Coro/jit-" CORO_JIT_TYPE ".pl'", 1);
		3410
		3411	PUSHMARK (SP);
		3412	#define VARx(name,expr,type) pushav_4uv (aTHX_ (UV)&(expr), sizeof (expr), offsetof (perl_slots, name), sizeof (type));
		3413	#include "state.h"
		3414	count = call_pv ("Coro::State::_jit", G_ARRAY);
		3415	SPAGAIN;
		3416
		3417	save = POPs; save_ptr = SvPVbyte (save, save_len);
		3418	load = POPs; load_ptr = SvPVbyte (load, load_len);
		3419
		3420	map_len = load_len + save_len + 16;
		3421
		3422	map_base = mmap (0, map_len, PROT_READ | PROT_WRITE | PROT_EXEC, MAP_PRIVATE | MAP_ANONYMOUS, -1, 0);
		3423
		3424	assert (("Coro: unable to mmap jit code page, cannot continue.", map_base != (char *)MAP_FAILED));
		3425
		3426	load_perl_slots = (load_save_perl_slots_type)map_base;
		3427	memcpy (map_base, load_ptr, load_len);
		3428
		3429	map_base += (load_len + 15) & ~15;
		3430
		3431	save_perl_slots = (load_save_perl_slots_type)map_base;
		3432	memcpy (map_base, save_ptr, save_len);
		3433
		3434	/* we are good citizens and try to make the page read-only, so the evil evil */
		3435	/* hackers might have it a bit more difficult */
		3436	mprotect (map_base, map_len, PROT_READ | PROT_EXEC);
		3437
		3438	PUTBACK;
		3439	eval_pv ("undef &Coro::State::_jit", 1);
		3440	}
		3441
2856	#endif	3442	#endif
2857		3443
2858	MODULE = Coro::State PACKAGE = Coro::State PREFIX = api_	3444	MODULE = Coro::State PACKAGE = Coro::State PREFIX = api_
2859		3445
2860	PROTOTYPES: DISABLE	3446	PROTOTYPES: DISABLE
…		…
2864	#ifdef USE_ITHREADS	3450	#ifdef USE_ITHREADS
2865	# if CORO_PTHREAD	3451	# if CORO_PTHREAD
2866	coro_thx = PERL_GET_CONTEXT;	3452	coro_thx = PERL_GET_CONTEXT;
2867	# endif	3453	# endif
2868	#endif	3454	#endif
2869	BOOT_PAGESIZE;	3455	/* perl defines these to check for existance first, but why it doesn't */
		3456	/* just create them one at init time is not clear to me, except for */
		3457	/* programs trying to delete them, but... */
		3458	/* anyway, we declare this as invalid and make sure they are initialised here */
		3459	DEFSV;
		3460	ERRSV;
2870		3461
2871	cctx_current = cctx_new_empty ();	3462	cctx_current = cctx_new_empty ();
2872		3463
2873	irsgv = gv_fetchpv ("/" , GV_ADD|GV_NOTQUAL, SVt_PV);	3464	irsgv = gv_fetchpv ("/" , GV_ADD|GV_NOTQUAL, SVt_PV);
2874	stdoutgv = gv_fetchpv ("STDOUT", GV_ADD|GV_NOTQUAL, SVt_PVIO);	3465	stdoutgv = gv_fetchpv ("STDOUT", GV_ADD|GV_NOTQUAL, SVt_PVIO);
…		…
2914	coroapi.prepare_nop = prepare_nop;	3505	coroapi.prepare_nop = prepare_nop;
2915	coroapi.prepare_schedule = prepare_schedule;	3506	coroapi.prepare_schedule = prepare_schedule;
2916	coroapi.prepare_cede = prepare_cede;	3507	coroapi.prepare_cede = prepare_cede;
2917	coroapi.prepare_cede_notself = prepare_cede_notself;	3508	coroapi.prepare_cede_notself = prepare_cede_notself;
2918		3509
2919	{	3510	time_init (aTHX);
2920	SV **svp = hv_fetch (PL_modglobal, "Time::NVtime", 12, 0);
2921		3511
2922	if (!svp) croak ("Time::HiRes is required");
2923	if (!SvIOK (*svp)) croak ("Time::NVtime isn't a function pointer");
2924
2925	nvtime = INT2PTR (double (*)(), SvIV (*svp));
2926	}
2927
2928	assert (("PRIO_NORMAL must be 0", !PRIO_NORMAL));	3512	assert (("PRIO_NORMAL must be 0", !CORO_PRIO_NORMAL));
		3513	#if CORO_JIT
		3514	PUTBACK;
		3515	jit_init (aTHX);
		3516	SPAGAIN;
		3517	#endif
2929	}	3518	}
2930		3519
2931	SV *	3520	SV *
2932	new (char *klass, ...)	3521	new (SV *klass, ...)
2933	ALIAS:	3522	ALIAS:
2934	Coro::new = 1	3523	Coro::new = 1
2935	CODE:	3524	CODE:
2936	{	3525	RETVAL = coro_new (aTHX_ ix ? coro_stash : coro_state_stash, &ST (1), items - 1, ix);
2937	struct coro *coro;	3526	OUTPUT:
2938	MAGIC *mg;
2939	HV *hv;
2940	CV *cb;
2941	int i;
2942
2943	if (items > 1)
2944	{
2945	cb = coro_sv_2cv (aTHX_ ST (1));
2946
2947	if (!ix)
2948	{
2949	if (CvISXSUB (cb))
2950	croak ("Coro::State doesn't support XS functions as coroutine start, caught");
2951
2952	if (!CvROOT (cb))
2953	croak ("Coro::State doesn't support autoloaded or undefined functions as coroutine start, caught");
2954	}
2955	}
2956
2957	Newz (0, coro, 1, struct coro);
2958	coro->args = newAV ();
2959	coro->flags = CF_NEW;
2960
2961	if (coro_first) coro_first->prev = coro;
2962	coro->next = coro_first;
2963	coro_first = coro;
2964
2965	coro->hv = hv = newHV ();
2966	mg = sv_magicext ((SV *)hv, 0, CORO_MAGIC_type_state, &coro_state_vtbl, (char *)coro, 0);
2967	mg->mg_flags |= MGf_DUP;
2968	RETVAL = sv_bless (newRV_noinc ((SV *)hv), gv_stashpv (klass, 1));
2969
2970	if (items > 1)
2971	{
2972	av_extend (coro->args, items - 1 + ix - 1);
2973
2974	if (ix)
2975	{
2976	av_push (coro->args, SvREFCNT_inc_NN ((SV *)cb));
2977	cb = cv_coro_run;
2978	}
2979
2980	coro->startcv = (CV *)SvREFCNT_inc_NN ((SV *)cb);
2981
2982	for (i = 2; i < items; i++)
2983	av_push (coro->args, newSVsv (ST (i)));
2984	}
2985	}
2986	OUTPUT:
2987	RETVAL	3527	RETVAL
2988		3528
2989	void	3529	void
2990	transfer (...)	3530	transfer (...)
2991	PROTOTYPE: $$	3531	PROTOTYPE: $$
2992	CODE:	3532	CODE:
2993	CORO_EXECUTE_SLF_XS (slf_init_transfer);	3533	CORO_EXECUTE_SLF_XS (slf_init_transfer);
2994
2995	bool
2996	_destroy (SV *coro_sv)
2997	CODE:
2998	RETVAL = coro_state_destroy (aTHX_ SvSTATE (coro_sv));
2999	OUTPUT:
3000	RETVAL
3001
3002	void
3003	_exit (int code)
3004	PROTOTYPE: $
3005	CODE:
3006	_exit (code);
3007		3534
3008	SV *	3535	SV *
3009	clone (Coro::State coro)	3536	clone (Coro::State coro)
3010	CODE:	3537	CODE:
3011	{	3538	{
…		…
3066	void	3593	void
3067	list ()	3594	list ()
3068	PROTOTYPE:	3595	PROTOTYPE:
3069	PPCODE:	3596	PPCODE:
3070	{	3597	{
3071	struct coro *coro;	3598	struct coro *coro;
3072	for (coro = coro_first; coro; coro = coro->next)	3599	for (coro = coro_first; coro; coro = coro->next)
3073	if (coro->hv)	3600	if (coro->hv)
3074	XPUSHs (sv_2mortal (newRV_inc ((SV *)coro->hv)));	3601	XPUSHs (sv_2mortal (newRV_inc ((SV *)coro->hv)));
3075	}	3602	}
3076		3603
…		…
3081	CODE:	3608	CODE:
3082	{	3609	{
3083	if (coro->mainstack && ((coro->flags & CF_RUNNING) || coro->slot))	3610	if (coro->mainstack && ((coro->flags & CF_RUNNING) || coro->slot))
3084	{	3611	{
3085	struct coro *current = SvSTATE_current;	3612	struct coro *current = SvSTATE_current;
		3613	struct CoroSLF slf_save;
3086		3614
3087	if (current != coro)	3615	if (current != coro)
3088	{	3616	{
3089	PUTBACK;	3617	PUTBACK;
3090	save_perl (aTHX_ current);	3618	save_perl (aTHX_ current);
3091	load_perl (aTHX_ coro);	3619	load_perl (aTHX_ coro);
		3620	/* the coro is most likely in an active SLF call.
		3621	* while not strictly required (the code we execute is
		3622	* not allowed to call any SLF functions), it's cleaner
		3623	* to reinitialise the slf_frame and restore it later.
		3624	* This might one day allow us to actually do SLF calls
		3625	* from code executed here.
		3626	*/
		3627	slf_save = slf_frame;
		3628	slf_frame.prepare = 0;
3092	SPAGAIN;	3629	SPAGAIN;
3093	}	3630	}
3094		3631
3095	PUSHSTACK;	3632	PUSHSTACK;
3096		3633
…		…
3100	if (ix)	3637	if (ix)
3101	eval_sv (coderef, 0);	3638	eval_sv (coderef, 0);
3102	else	3639	else
3103	call_sv (coderef, G_KEEPERR | G_EVAL | G_VOID | G_DISCARD);	3640	call_sv (coderef, G_KEEPERR | G_EVAL | G_VOID | G_DISCARD);
3104		3641
		3642	POPSTACK;
3105	SPAGAIN;	3643	SPAGAIN;
3106	POPSTACK;
3107		3644
3108	if (current != coro)	3645	if (current != coro)
3109	{	3646	{
3110	PUTBACK;	3647	PUTBACK;
		3648	slf_frame = slf_save;
3111	save_perl (aTHX_ coro);	3649	save_perl (aTHX_ coro);
3112	load_perl (aTHX_ current);	3650	load_perl (aTHX_ current);
3113	SPAGAIN;	3651	SPAGAIN;
3114	}	3652	}
3115	}	3653	}
…		…
3120	PROTOTYPE: $	3658	PROTOTYPE: $
3121	ALIAS:	3659	ALIAS:
3122	is_ready = CF_READY	3660	is_ready = CF_READY
3123	is_running = CF_RUNNING	3661	is_running = CF_RUNNING
3124	is_new = CF_NEW	3662	is_new = CF_NEW
3125	is_destroyed = CF_DESTROYED	3663	is_destroyed = CF_ZOMBIE
		3664	is_zombie = CF_ZOMBIE
		3665	is_suspended = CF_SUSPENDED
3126	CODE:	3666	CODE:
3127	RETVAL = boolSV (coro->flags & ix);	3667	RETVAL = boolSV (coro->flags & ix);
3128	OUTPUT:	3668	OUTPUT:
3129	RETVAL	3669	RETVAL
3130		3670
3131	void	3671	void
3132	throw (Coro::State self, SV *throw = &PL_sv_undef)	3672	throw (SV *self, SV *exception = &PL_sv_undef)
3133	PROTOTYPE: $;$	3673	PROTOTYPE: $;$
3134	CODE:	3674	CODE:
3135	{	3675	{
		3676	struct coro *coro = SvSTATE (self);
3136	struct coro *current = SvSTATE_current;	3677	struct coro *current = SvSTATE_current;
3137	SV **throwp = self == current ? &CORO_THROW : &self->except;	3678	SV **exceptionp = coro == current ? &CORO_THROW : &coro->except;
3138	SvREFCNT_dec (*throwp);	3679	SvREFCNT_dec (*exceptionp);
3139	*throwp = SvOK (throw) ? newSVsv (throw) : 0;	3680	SvGETMAGIC (exception);
		3681	*exceptionp = SvOK (exception) ? newSVsv (exception) : 0;
		3682
		3683	api_ready (aTHX_ self);
3140	}	3684	}
3141		3685
3142	void	3686	void
3143	api_trace (SV *coro, int flags = CC_TRACE | CC_TRACE_SUB)	3687	api_trace (SV *coro, int flags = CC_TRACE | CC_TRACE_SUB)
3144	PROTOTYPE: $;$	3688	PROTOTYPE: $;$
…		…
3195	SV **dst = ix ? (SV **)&self->slot->defav : (SV **)&self->slot->defsv;	3739	SV **dst = ix ? (SV **)&self->slot->defav : (SV **)&self->slot->defsv;
3196		3740
3197	SV *tmp = *src; *src = *dst; *dst = tmp;	3741	SV *tmp = *src; *src = *dst; *dst = tmp;
3198	}	3742	}
3199		3743
		3744	void
		3745	cancel (Coro::State self)
		3746	CODE:
		3747	coro_state_destroy (aTHX_ self);
		3748
		3749	SV *
		3750	enable_times (int enabled = enable_times)
		3751	CODE:
		3752	{
		3753	RETVAL = boolSV (enable_times);
		3754
		3755	if (enabled != enable_times)
		3756	{
		3757	enable_times = enabled;
		3758
		3759	coro_times_update ();
		3760	(enabled ? coro_times_sub : coro_times_add)(SvSTATE (coro_current));
		3761	}
		3762	}
		3763	OUTPUT:
		3764	RETVAL
		3765
		3766	void
		3767	times (Coro::State self)
		3768	PPCODE:
		3769	{
		3770	struct coro *current = SvSTATE (coro_current);
		3771
		3772	if (ecb_expect_false (current == self))
		3773	{
		3774	coro_times_update ();
		3775	coro_times_add (SvSTATE (coro_current));
		3776	}
		3777
		3778	EXTEND (SP, 2);
		3779	PUSHs (sv_2mortal (newSVnv (self->t_real [0] + self->t_real [1] * 1e-9)));
		3780	PUSHs (sv_2mortal (newSVnv (self->t_cpu [0] + self->t_cpu [1] * 1e-9)));
		3781
		3782	if (ecb_expect_false (current == self))
		3783	coro_times_sub (SvSTATE (coro_current));
		3784	}
		3785
		3786	void
		3787	swap_sv (Coro::State coro, SV *sv, SV *swapsv)
		3788	CODE:
		3789	{
		3790	struct coro *current = SvSTATE_current;
		3791
		3792	if (current == coro)
		3793	SWAP_SVS (current);
		3794
		3795	if (!coro->swap_sv)
		3796	coro->swap_sv = newAV ();
		3797
		3798	av_push (coro->swap_sv, SvREFCNT_inc_NN (SvRV (sv )));
		3799	av_push (coro->swap_sv, SvREFCNT_inc_NN (SvRV (swapsv)));
		3800
		3801	if (current == coro)
		3802	SWAP_SVS (current);
		3803	}
		3804
3200		3805
3201	MODULE = Coro::State PACKAGE = Coro	3806	MODULE = Coro::State PACKAGE = Coro
3202		3807
3203	BOOT:	3808	BOOT:
3204	{	3809	{
3205	int i;
3206
3207	sv_pool_rss = coro_get_sv (aTHX_ "Coro::POOL_RSS" , TRUE);	3810	sv_pool_rss = coro_get_sv (aTHX_ "Coro::POOL_RSS" , TRUE);
3208	sv_pool_size = coro_get_sv (aTHX_ "Coro::POOL_SIZE" , TRUE);	3811	sv_pool_size = coro_get_sv (aTHX_ "Coro::POOL_SIZE" , TRUE);
3209	cv_coro_run = get_cv ( "Coro::_coro_run" , GV_ADD);	3812	cv_coro_run = get_cv ( "Coro::_coro_run" , GV_ADD);
3210	cv_coro_terminate = get_cv ( "Coro::terminate" , GV_ADD);
3211	coro_current = coro_get_sv (aTHX_ "Coro::current" , FALSE); SvREADONLY_on (coro_current);	3813	coro_current = coro_get_sv (aTHX_ "Coro::current" , FALSE); SvREADONLY_on (coro_current);
3212	av_async_pool = coro_get_av (aTHX_ "Coro::async_pool", TRUE);	3814	av_async_pool = coro_get_av (aTHX_ "Coro::async_pool", TRUE);
3213	av_destroy = coro_get_av (aTHX_ "Coro::destroy" , TRUE);	3815	av_destroy = coro_get_av (aTHX_ "Coro::destroy" , TRUE);
3214	sv_manager = coro_get_sv (aTHX_ "Coro::manager" , TRUE);	3816	sv_manager = coro_get_sv (aTHX_ "Coro::manager" , TRUE);
3215	sv_idle = coro_get_sv (aTHX_ "Coro::idle" , TRUE);	3817	sv_idle = coro_get_sv (aTHX_ "Coro::idle" , TRUE);
3216		3818
3217	sv_async_pool_idle = newSVpv ("[async pool idle]", 0); SvREADONLY_on (sv_async_pool_idle);	3819	sv_async_pool_idle = newSVpv ("[async pool idle]", 0); SvREADONLY_on (sv_async_pool_idle);
3218	sv_Coro = newSVpv ("Coro", 0); SvREADONLY_on (sv_Coro);	3820	sv_Coro = newSVpv ("Coro", 0); SvREADONLY_on (sv_Coro);
3219	cv_pool_handler = get_cv ("Coro::pool_handler", GV_ADD); SvREADONLY_on (cv_pool_handler);	3821	cv_pool_handler = get_cv ("Coro::pool_handler", GV_ADD); SvREADONLY_on (cv_pool_handler);
3220	cv_coro_state_new = get_cv ("Coro::State::new", 0); SvREADONLY_on (cv_coro_state_new);	3822	CvNODEBUG_on (get_cv ("Coro::_pool_handler", 0)); /* work around a debugger bug */
3221		3823
3222	coro_stash = gv_stashpv ("Coro", TRUE);	3824	coro_stash = gv_stashpv ("Coro", TRUE);
3223		3825
3224	newCONSTSUB (coro_stash, "PRIO_MAX", newSViv (PRIO_MAX));	3826	newCONSTSUB (coro_stash, "PRIO_MAX", newSViv (CORO_PRIO_MAX));
3225	newCONSTSUB (coro_stash, "PRIO_HIGH", newSViv (PRIO_HIGH));	3827	newCONSTSUB (coro_stash, "PRIO_HIGH", newSViv (CORO_PRIO_HIGH));
3226	newCONSTSUB (coro_stash, "PRIO_NORMAL", newSViv (PRIO_NORMAL));	3828	newCONSTSUB (coro_stash, "PRIO_NORMAL", newSViv (CORO_PRIO_NORMAL));
3227	newCONSTSUB (coro_stash, "PRIO_LOW", newSViv (PRIO_LOW));	3829	newCONSTSUB (coro_stash, "PRIO_LOW", newSViv (CORO_PRIO_LOW));
3228	newCONSTSUB (coro_stash, "PRIO_IDLE", newSViv (PRIO_IDLE));	3830	newCONSTSUB (coro_stash, "PRIO_IDLE", newSViv (CORO_PRIO_IDLE));
3229	newCONSTSUB (coro_stash, "PRIO_MIN", newSViv (PRIO_MIN));	3831	newCONSTSUB (coro_stash, "PRIO_MIN", newSViv (CORO_PRIO_MIN));
3230
3231	for (i = PRIO_MAX - PRIO_MIN + 1; i--; )
3232	coro_ready[i] = newAV ();
3233		3832
3234	{	3833	{
3235	SV *sv = coro_get_sv (aTHX_ "Coro::API", TRUE);	3834	SV *sv = coro_get_sv (aTHX_ "Coro::API", TRUE);
3236		3835
3237	coroapi.schedule = api_schedule;	3836	coroapi.schedule = api_schedule;
…		…
3247	sv_setiv (sv, (IV)&coroapi);	3846	sv_setiv (sv, (IV)&coroapi);
3248	SvREADONLY_on (sv);	3847	SvREADONLY_on (sv);
3249	}	3848	}
3250	}	3849	}
3251		3850
		3851	SV *
		3852	async (...)
		3853	PROTOTYPE: &@
		3854	CODE:
		3855	RETVAL = coro_new (aTHX_ coro_stash, &ST (0), items, 1);
		3856	api_ready (aTHX_ RETVAL);
		3857	OUTPUT:
		3858	RETVAL
		3859
		3860	void
		3861	_destroy (Coro::State coro)
		3862	CODE:
		3863	/* used by the manager thread */
		3864	coro_state_destroy (aTHX_ coro);
		3865
		3866	void
		3867	on_destroy (Coro::State coro, SV *cb)
		3868	CODE:
		3869	coro_push_on_destroy (aTHX_ coro, newSVsv (cb));
		3870
		3871	void
		3872	join (...)
		3873	CODE:
		3874	CORO_EXECUTE_SLF_XS (slf_init_join);
		3875
3252	void	3876	void
3253	terminate (...)	3877	terminate (...)
3254	CODE:	3878	CODE:
3255	CORO_EXECUTE_SLF_XS (slf_init_terminate);	3879	CORO_EXECUTE_SLF_XS (slf_init_terminate);
3256		3880
3257	void	3881	void
		3882	cancel (...)
		3883	CODE:
		3884	CORO_EXECUTE_SLF_XS (slf_init_cancel);
		3885
		3886	int
		3887	safe_cancel (Coro::State self, ...)
		3888	C_ARGS: aTHX_ self, &ST (1), items - 1
		3889
		3890	void
3258	schedule (...)	3891	schedule (...)
3259	CODE:	3892	CODE:
3260	CORO_EXECUTE_SLF_XS (slf_init_schedule);	3893	CORO_EXECUTE_SLF_XS (slf_init_schedule);
3261		3894
3262	void	3895	void
…		…
3276		3909
3277	void	3910	void
3278	cede_notself (...)	3911	cede_notself (...)
3279	CODE:	3912	CODE:
3280	CORO_EXECUTE_SLF_XS (slf_init_cede_notself);	3913	CORO_EXECUTE_SLF_XS (slf_init_cede_notself);
3281
3282	void
3283	_cancel (Coro::State self)
3284	CODE:
3285	coro_state_destroy (aTHX_ self);
3286	coro_call_on_destroy (aTHX_ self);
3287		3914
3288	void	3915	void
3289	_set_current (SV *current)	3916	_set_current (SV *current)
3290	PROTOTYPE: $	3917	PROTOTYPE: $
3291	CODE:	3918	CODE:
…		…
3295	void	3922	void
3296	_set_readyhook (SV *hook)	3923	_set_readyhook (SV *hook)
3297	PROTOTYPE: $	3924	PROTOTYPE: $
3298	CODE:	3925	CODE:
3299	SvREFCNT_dec (coro_readyhook);	3926	SvREFCNT_dec (coro_readyhook);
		3927	SvGETMAGIC (hook);
		3928	if (SvOK (hook))
		3929	{
3300	coro_readyhook = SvOK (hook) ? newSVsv (hook) : 0;	3930	coro_readyhook = newSVsv (hook);
		3931	CORO_READYHOOK = invoke_sv_ready_hook_helper;
		3932	}
		3933	else
		3934	{
		3935	coro_readyhook = 0;
		3936	CORO_READYHOOK = 0;
		3937	}
3301		3938
3302	int	3939	int
3303	prio (Coro::State coro, int newprio = 0)	3940	prio (Coro::State coro, int newprio = 0)
3304	PROTOTYPE: $;$	3941	PROTOTYPE: $;$
3305	ALIAS:	3942	ALIAS:
…		…
3311	if (items > 1)	3948	if (items > 1)
3312	{	3949	{
3313	if (ix)	3950	if (ix)
3314	newprio = coro->prio - newprio;	3951	newprio = coro->prio - newprio;
3315		3952
3316	if (newprio < PRIO_MIN) newprio = PRIO_MIN;	3953	if (newprio < CORO_PRIO_MIN) newprio = CORO_PRIO_MIN;
3317	if (newprio > PRIO_MAX) newprio = PRIO_MAX;	3954	if (newprio > CORO_PRIO_MAX) newprio = CORO_PRIO_MAX;
3318		3955
3319	coro->prio = newprio;	3956	coro->prio = newprio;
3320	}	3957	}
3321	}	3958	}
3322	OUTPUT:	3959	OUTPUT:
…		…
3337	RETVAL = coro_nready;	3974	RETVAL = coro_nready;
3338	OUTPUT:	3975	OUTPUT:
3339	RETVAL	3976	RETVAL
3340		3977
3341	void	3978	void
		3979	suspend (Coro::State self)
		3980	PROTOTYPE: $
		3981	CODE:
		3982	self->flags |= CF_SUSPENDED;
		3983
		3984	void
		3985	resume (Coro::State self)
		3986	PROTOTYPE: $
		3987	CODE:
		3988	self->flags &= ~CF_SUSPENDED;
		3989
		3990	void
3342	_pool_handler (...)	3991	_pool_handler (...)
3343	CODE:	3992	CODE:
3344	CORO_EXECUTE_SLF_XS (slf_init_pool_handler);	3993	CORO_EXECUTE_SLF_XS (slf_init_pool_handler);
3345		3994
3346	void	3995	void
…		…
3357	for (i = 1; i < items; ++i)	4006	for (i = 1; i < items; ++i)
3358	av_push (av, SvREFCNT_inc_NN (ST (i)));	4007	av_push (av, SvREFCNT_inc_NN (ST (i)));
3359		4008
3360	if ((SV *)hv == &PL_sv_undef)	4009	if ((SV *)hv == &PL_sv_undef)
3361	{	4010	{
3362	PUSHMARK (SP);	4011	SV *sv = coro_new (aTHX_ coro_stash, (SV **)&cv_pool_handler, 1, 1);
3363	EXTEND (SP, 2);
3364	PUSHs (sv_Coro);
3365	PUSHs ((SV *)cv_pool_handler);
3366	PUTBACK;
3367	call_sv ((SV *)cv_coro_state_new, G_SCALAR);
3368	SPAGAIN;
3369
3370	hv = (HV *)SvREFCNT_inc_NN (SvRV (POPs));	4012	hv = (HV *)SvREFCNT_inc_NN (SvRV (sv));
		4013	SvREFCNT_dec (sv);
3371	}	4014	}
3372		4015
3373	{	4016	{
3374	struct coro *coro = SvSTATE_hv (hv);	4017	struct coro *coro = SvSTATE_hv (hv);
3375		4018
…		…
3407	on_leave = 1	4050	on_leave = 1
3408	PROTOTYPE: &	4051	PROTOTYPE: &
3409	CODE:	4052	CODE:
3410	{	4053	{
3411	struct coro *coro = SvSTATE_current;	4054	struct coro *coro = SvSTATE_current;
3412	AV **avp = ix ? &coro->on_leave : &coro->on_enter;	4055	AV **avp = ix ? &coro->on_leave : &coro->on_enter;
3413		4056
3414	block = (SV *)coro_sv_2cv (block);	4057	block = s_get_cv_croak (block);
3415		4058
3416	if (!*avp)	4059	if (!*avp)
3417	*avp = newAV ();	4060	*avp = newAV ();
3418		4061
3419	av_push (*avp, SvREFCNT_inc (block));	4062	av_push (*avp, SvREFCNT_inc (block));
3420		4063
3421	if (!ix)	4064	if (!ix)
3422	on_enterleave_call (aTHX_ block);	4065	on_enterleave_call (aTHX_ block);
3423		4066
3424	LEAVE; /* pp_entersub unfortunately forces an ENTER/LEAVE around xs calls */	4067	LEAVE; /* pp_entersub unfortunately forces an ENTER/LEAVE around XS calls */
3425	SAVEDESTRUCTOR_X (ix ? coro_pop_on_leave : coro_pop_on_enter, (void *)coro);	4068	SAVEDESTRUCTOR_X (ix ? coro_pop_on_leave : coro_pop_on_enter, (void *)coro);
3426	ENTER; /* pp_entersub unfortunately forces an ENTER/LEAVE around xs calls */	4069	ENTER; /* pp_entersub unfortunately forces an ENTER/LEAVE around XS calls */
3427	}	4070	}
3428		4071
3429		4072
3430	MODULE = Coro::State PACKAGE = PerlIO::cede	4073	MODULE = Coro::State PACKAGE = PerlIO::cede
3431		4074
…		…
3436	MODULE = Coro::State PACKAGE = Coro::Semaphore	4079	MODULE = Coro::State PACKAGE = Coro::Semaphore
3437		4080
3438	SV *	4081	SV *
3439	new (SV *klass, SV *count = 0)	4082	new (SV *klass, SV *count = 0)
3440	CODE:	4083	CODE:
		4084	{
		4085	int semcnt = 1;
		4086
		4087	if (count)
		4088	{
		4089	SvGETMAGIC (count);
		4090
		4091	if (SvOK (count))
		4092	semcnt = SvIV (count);
		4093	}
		4094
3441	RETVAL = sv_bless (	4095	RETVAL = sv_bless (
3442	coro_waitarray_new (aTHX_ count && SvOK (count) ? SvIV (count) : 1),	4096	coro_waitarray_new (aTHX_ semcnt),
3443	GvSTASH (CvGV (cv))	4097	GvSTASH (CvGV (cv))
3444	);	4098	);
		4099	}
3445	OUTPUT:	4100	OUTPUT:
3446	RETVAL	4101	RETVAL
3447		4102
3448	# helper for Coro::Channel	4103	# helper for Coro::Channel and others
3449	SV *	4104	SV *
3450	_alloc (int count)	4105	_alloc (int count)
3451	CODE:	4106	CODE:
3452	RETVAL = coro_waitarray_new (aTHX_ count);	4107	RETVAL = coro_waitarray_new (aTHX_ count);
3453	OUTPUT:	4108	OUTPUT:
…		…
3495	XSRETURN_NO;	4150	XSRETURN_NO;
3496	}	4151	}
3497		4152
3498	void	4153	void
3499	waiters (SV *self)	4154	waiters (SV *self)
3500	PPCODE:	4155	PPCODE:
3501	{	4156	{
3502	AV *av = (AV *)SvRV (self);	4157	AV *av = (AV *)SvRV (self);
3503	int wcount = AvFILLp (av) + 1 - 1;	4158	int wcount = AvFILLp (av) + 1 - 1;
3504		4159
3505	if (GIMME_V == G_SCALAR)	4160	if (GIMME_V == G_SCALAR)
…		…
3511	for (i = 1; i <= wcount; ++i)	4166	for (i = 1; i <= wcount; ++i)
3512	PUSHs (sv_2mortal (newRV_inc (AvARRAY (av)[i])));	4167	PUSHs (sv_2mortal (newRV_inc (AvARRAY (av)[i])));
3513	}	4168	}
3514	}	4169	}
3515		4170
		4171	MODULE = Coro::State PACKAGE = Coro::SemaphoreSet
		4172
		4173	void
		4174	_may_delete (SV *sem, int count, unsigned int extra_refs)
		4175	PPCODE:
		4176	{
		4177	AV *av = (AV *)SvRV (sem);
		4178
		4179	if (SvREFCNT ((SV *)av) == 1 + extra_refs
		4180	&& AvFILLp (av) == 0 /* no waiters, just count */
		4181	&& SvIV (AvARRAY (av)[0]) == count)
		4182	XSRETURN_YES;
		4183
		4184	XSRETURN_NO;
		4185	}
		4186
3516	MODULE = Coro::State PACKAGE = Coro::Signal	4187	MODULE = Coro::State PACKAGE = Coro::Signal
3517		4188
3518	SV *	4189	SV *
3519	new (SV *klass)	4190	new (SV *klass)
3520	CODE:	4191	CODE:
…		…
3532		4203
3533	void	4204	void
3534	broadcast (SV *self)	4205	broadcast (SV *self)
3535	CODE:	4206	CODE:
3536	{	4207	{
3537	AV *av = (AV *)SvRV (self);	4208	AV *av = (AV *)SvRV (self);
3538	coro_signal_wake (aTHX_ av, AvFILLp (av));	4209	coro_signal_wake (aTHX_ av, AvFILLp (av));
3539	}	4210	}
3540		4211
3541	void	4212	void
3542	send (SV *self)	4213	send (SV *self)
…		…
3550	SvIVX (AvARRAY (av)[0]) = 1; /* remember the signal */	4221	SvIVX (AvARRAY (av)[0]) = 1; /* remember the signal */
3551	}	4222	}
3552		4223
3553	IV	4224	IV
3554	awaited (SV *self)	4225	awaited (SV *self)
3555	CODE:	4226	CODE:
3556	RETVAL = AvFILLp ((AV *)SvRV (self)) + 1 - 1;	4227	RETVAL = AvFILLp ((AV *)SvRV (self)) + 1 - 1;
3557	OUTPUT:	4228	OUTPUT:
3558	RETVAL	4229	RETVAL
3559		4230
3560		4231
…		…
3565		4236
3566	void	4237	void
3567	_schedule (...)	4238	_schedule (...)
3568	CODE:	4239	CODE:
3569	{	4240	{
3570	static int incede;	4241	static int incede;
3571		4242
3572	api_cede_notself (aTHX);	4243	api_cede_notself (aTHX);
3573		4244
3574	++incede;	4245	++incede;
3575	while (coro_nready >= incede && api_cede (aTHX))	4246	while (coro_nready >= incede && api_cede (aTHX))
…		…
3591		4262
3592	void	4263	void
3593	_register (char *target, char *proto, SV *req)	4264	_register (char *target, char *proto, SV *req)
3594	CODE:	4265	CODE:
3595	{	4266	{
3596	CV *req_cv = coro_sv_2cv (aTHX_ req);	4267	SV *req_cv = s_get_cv_croak (req);
3597	/* newXSproto doesn't return the CV on 5.8 */	4268	/* newXSproto doesn't return the CV on 5.8 */
3598	CV *slf_cv = newXS (target, coro_aio_req_xs, __FILE__);	4269	CV *slf_cv = newXS (target, coro_aio_req_xs, __FILE__);
3599	sv_setpv ((SV *)slf_cv, proto);	4270	sv_setpv ((SV *)slf_cv, proto);
3600	sv_magicext ((SV *)slf_cv, (SV *)req_cv, CORO_MAGIC_type_aio, 0, 0, 0);	4271	sv_magicext ((SV *)slf_cv, (SV *)req_cv, CORO_MAGIC_type_aio, 0, 0, 0);
3601	}	4272	}
3602		4273
		4274	MODULE = Coro::State PACKAGE = Coro::Select
		4275
		4276	void
		4277	patch_pp_sselect ()
		4278	CODE:
		4279	if (!coro_old_pp_sselect)
		4280	{
		4281	coro_select_select = (SV *)get_cv ("Coro::Select::select", 0);
		4282	coro_old_pp_sselect = PL_ppaddr [OP_SSELECT];
		4283	PL_ppaddr [OP_SSELECT] = coro_pp_sselect;
		4284	}
		4285
		4286	void
		4287	unpatch_pp_sselect ()
		4288	CODE:
		4289	if (coro_old_pp_sselect)
		4290	{
		4291	PL_ppaddr [OP_SSELECT] = coro_old_pp_sselect;
		4292	coro_old_pp_sselect = 0;
		4293	}
		4294
		4295	MODULE = Coro::State PACKAGE = Coro::Util
		4296
		4297	void
		4298	_exit (int code)
		4299	CODE:
		4300	_exit (code);
		4301
		4302	NV
		4303	time ()
		4304	CODE:
		4305	RETVAL = nvtime (aTHX);
		4306	OUTPUT:
		4307	RETVAL
		4308
		4309	NV
		4310	gettimeofday ()
		4311	PPCODE:
		4312	{
		4313	UV tv [2];
		4314	u2time (aTHX_ tv);
		4315	EXTEND (SP, 2);
		4316	PUSHs (sv_2mortal (newSVuv (tv [0])));
		4317	PUSHs (sv_2mortal (newSVuv (tv [1])));
		4318	}
		4319

Diff Legend

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