ViewVC Help

View File | Revision Log | Show Annotations | Download File

/cvs/Coro/Coro/State.xs

Comparing Coro/Coro/State.xs (file contents):
Revision 1.342 by root, Mon Dec 15 16:22:34 2008 UTC vs.
Revision 1.436 by root, Tue Nov 5 14:38:46 2013 UTC

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

Diff Legend

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