ViewVC Help

View File | Revision Log | Show Annotations | Download File

/cvs/Coro/Coro/State.xs

Comparing Coro/Coro/State.xs (file contents):
Revision 1.329 by root, Tue Nov 25 20:48:41 2008 UTC vs.
Revision 1.431 by root, Fri Feb 8 22:29:18 2013 UTC

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

Diff Legend

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