ViewVC Help

View File | Revision Log | Show Annotations | Download File

/cvs/Coro/Coro/State.xs

Comparing Coro/Coro/State.xs (file contents):
Revision 1.333 by root, Thu Nov 27 12:39:00 2008 UTC vs.
Revision 1.439 by root, Tue Nov 19 05:16:01 2013 UTC

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

Diff Legend

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