ViewVC Help

View File | Revision Log | Show Annotations | Download File

/cvs/Coro/Coro/State.xs

Comparing Coro/Coro/State.xs (file contents):
Revision 1.235 by root, Sat May 10 00:13:18 2008 UTC vs.
Revision 1.450 by root, Sun Jun 28 22:31:03 2015 UTC

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

Diff Legend

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