ViewVC Help

View File | Revision Log | Show Annotations | Download File

/cvs/Coro/Coro/State.xs

Comparing Coro/Coro/State.xs (file contents):
Revision 1.338 by root, Sun Dec 7 15:33:21 2008 UTC vs.
Revision 1.448 by root, Thu Jun 4 22:58:28 2015 UTC

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

Diff Legend

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