[ViewVC] Diff of: cvs/Coro/Coro/State.xs

Comparing Coro/Coro/State.xs (file contents):
Revision 1.277 by root, Sat Nov 15 18:40:55 2008 UTC vs.
Revision 1.337 by root, Fri Dec 5 18:26:10 2008 UTC

…		…
16		16
17	#ifdef WIN32	17	#ifdef WIN32
18	# undef setjmp	18	# undef setjmp
19	# undef longjmp	19	# undef longjmp
20	# undef _exit	20	# undef _exit
21	# define setjmp _setjmp // deep magic, don't ask	21	# define setjmp _setjmp /* deep magic */
22	#else	22	#else
23	# include <inttypes.h> /* most portable stdint.h */	23	# include <inttypes.h> /* most portable stdint.h */
24	#endif	24	#endif
25		25
26	#ifdef HAVE_MMAP	26	#ifdef HAVE_MMAP
…		…
55		55
56	#define PERL_VERSION_ATLEAST(a,b,c) \	56	#define PERL_VERSION_ATLEAST(a,b,c) \
57	(PERL_REVISION > (a) \	57	(PERL_REVISION > (a) \
58	\|\| (PERL_REVISION == (a) \	58	\|\| (PERL_REVISION == (a) \
59	&& (PERL_VERSION > (b) \	59	&& (PERL_VERSION > (b) \
60	\|\| (PERL_VERSION == (b) && PERLSUBVERSION >= (c)))))	60	\|\| (PERL_VERSION == (b) && PERL_SUBVERSION >= (c)))))
61		61
62	#if !PERL_VERSION_ATLEAST (5,6,0)	62	#if !PERL_VERSION_ATLEAST (5,6,0)
63	# ifndef PL_ppaddr	63	# ifndef PL_ppaddr
64	# define PL_ppaddr ppaddr	64	# define PL_ppaddr ppaddr
65	# endif	65	# endif
…		…
95	# define GV_NOTQUAL 0	95	# define GV_NOTQUAL 0
96	#endif	96	#endif
97	#ifndef newSV	97	#ifndef newSV
98	# define newSV(l) NEWSV(0,l)	98	# define newSV(l) NEWSV(0,l)
99	#endif	99	#endif
		100	#ifndef CvISXSUB_on
		101	# define CvISXSUB_on(cv) (void)cv
		102	#endif
		103	#ifndef CvISXSUB
		104	# define CvISXSUB(cv) (CvXSUB (cv) ? TRUE : FALSE)
		105	#endif
		106	#ifndef Newx
		107	# define Newx(ptr,nitems,type) New (0,ptr,nitems,type)
		108	#endif
100		109
101	/* 5.8.7 */	110	/* 5.8.7 */
102	#ifndef SvRV_set	111	#ifndef SvRV_set
103	# define SvRV_set(s,v) SvRV(s) = (v)	112	# define SvRV_set(s,v) SvRV(s) = (v)
104	#endif	113	#endif
…		…
117	#endif	126	#endif
118		127
119	/* The next macros try to return the current stack pointer, in an as	128	/* The next macros try to return the current stack pointer, in an as
120	* portable way as possible. */	129	* portable way as possible. */
121	#if __GNUC__ >= 4	130	#if __GNUC__ >= 4
		131	# define dSTACKLEVEL int stacklevel_dummy
122	# define dSTACKLEVEL void *stacklevel = __builtin_frame_address (0)	132	# define STACKLEVEL __builtin_frame_address (0)
123	#else	133	#else
124	# define dSTACKLEVEL volatile void stacklevel = (volatile void )&stacklevel	134	# define dSTACKLEVEL volatile void *stacklevel
		135	# define STACKLEVEL ((void *)&stacklevel)
125	#endif	136	#endif
126		137
127	#define IN_DESTRUCT (PL_main_cv == Nullcv)	138	#define IN_DESTRUCT PL_dirty
128		139
129	#if __GNUC__ >= 3	140	#if __GNUC__ >= 3
130	# define attribute(x) __attribute__(x)	141	# define attribute(x) __attribute__(x)
131	# define expect(expr,value) __builtin_expect ((expr),(value))	142	# define expect(expr,value) __builtin_expect ((expr),(value))
132	# define INLINE static inline	143	# define INLINE static inline
…		…
140	#define expect_true(expr) expect ((expr) != 0, 1)	151	#define expect_true(expr) expect ((expr) != 0, 1)
141		152
142	#define NOINLINE attribute ((noinline))	153	#define NOINLINE attribute ((noinline))
143		154
144	#include "CoroAPI.h"	155	#include "CoroAPI.h"
		156	#define GCoroAPI (&coroapi) /* very sneaky */
145		157
146	#ifdef USE_ITHREADS	158	#ifdef USE_ITHREADS
147
148	static perl_mutex coro_lock;
149	# define LOCK do { MUTEX_LOCK (&coro_lock); } while (0)
150	# define UNLOCK do { MUTEX_UNLOCK (&coro_lock); } while (0)
151	# if CORO_PTHREAD	159	# if CORO_PTHREAD
152	static void *coro_thx;	160	static void *coro_thx;
153	# endif	161	# endif
154
155	#else
156
157	# define LOCK (void)0
158	# define UNLOCK (void)0
159
160	#endif	162	#endif
161
162	# undef LOCK
163	# define LOCK (void)0
164	# undef UNLOCK
165	# define UNLOCK (void)0
166
167	/* helper storage struct for Coro::AIO */
168	struct io_state
169	{
170	AV *res;
171	int errorno;
172	I32 laststype; /* U16 in 5.10.0 */
173	int laststatval;
174	Stat_t statcache;
175	};
176		163
177	static double (nvtime)(); / so why doesn't it take void? */	164	static double (nvtime)(); / so why doesn't it take void? */
		165
		166	/* we hijack an hopefully unused CV flag for our purposes */
		167	#define CVf_SLF 0x4000
		168	static OP *pp_slf (pTHX);
178		169
179	static U32 cctx_gen;	170	static U32 cctx_gen;
180	static size_t cctx_stacksize = CORO_STACKSIZE;	171	static size_t cctx_stacksize = CORO_STACKSIZE;
181	static struct CoroAPI coroapi;	172	static struct CoroAPI coroapi;
182	static AV main_mainstack; / used to differentiate between $main and others */	173	static AV main_mainstack; / used to differentiate between $main and others */
183	static JMPENV *main_top_env;	174	static JMPENV *main_top_env;
184	static HV coro_state_stash, coro_stash;	175	static HV coro_state_stash, coro_stash;
185	static volatile SV coro_mortal; / will be freed/thrown after next transfer */	176	static volatile SV coro_mortal; / will be freed/thrown after next transfer */
186	static volatile struct coro *transfer_next;	177
		178	static AV av_destroy; / destruction queue */
		179	static SV sv_manager; / the manager coro */
		180	static SV sv_idle; / $Coro::idle */
187		181
188	static GV irsgv; / $/ */	182	static GV irsgv; / $/ */
189	static GV stdoutgv; / STDOUT /	183	static GV stdoutgv; / STDOUT /
190	static SV *rv_diehook;	184	static SV *rv_diehook;
191	static SV *rv_warnhook;	185	static SV *rv_warnhook;
192	static HV hv_sig; / %SIG */	186	static HV hv_sig; / %SIG */
193		187
194	/* async_pool helper stuff */	188	/* async_pool helper stuff */
195	static SV *sv_pool_rss;	189	static SV *sv_pool_rss;
196	static SV *sv_pool_size;	190	static SV *sv_pool_size;
		191	static SV sv_async_pool_idle; / description string */
197	static AV *av_async_pool;	192	static AV av_async_pool; / idle pool */
		193	static SV sv_Coro; / class string */
		194	static CV *cv_pool_handler;
		195	static CV *cv_coro_state_new;
198		196
199	/* Coro::AnyEvent */	197	/* Coro::AnyEvent */
200	static SV *sv_activity;	198	static SV *sv_activity;
201		199
202	static struct coro_cctx *cctx_first;	200	static struct coro_cctx *cctx_first;
…		…
231	int valgrind_id;	229	int valgrind_id;
232	#endif	230	#endif
233	unsigned char flags;	231	unsigned char flags;
234	} coro_cctx;	232	} coro_cctx;
235		233
		234	coro_cctx cctx_current; / the currently running cctx */
		235
		236	/*****************************************************************************/
		237
236	enum {	238	enum {
237	CF_RUNNING = 0x0001, /* coroutine is running */	239	CF_RUNNING = 0x0001, /* coroutine is running */
238	CF_READY = 0x0002, /* coroutine is ready */	240	CF_READY = 0x0002, /* coroutine is ready */
239	CF_NEW = 0x0004, /* has never been switched to */	241	CF_NEW = 0x0004, /* has never been switched to */
240	CF_DESTROYED = 0x0008, /* coroutine data has been freed */	242	CF_DESTROYED = 0x0008, /* coroutine data has been freed */
…		…
245	{	247	{
246	SV *defsv;	248	SV *defsv;
247	AV *defav;	249	AV *defav;
248	SV *errsv;	250	SV *errsv;
249	SV *irsgv;	251	SV *irsgv;
		252	HV *hinthv;
250	#define VAR(name,type) type name;	253	#define VAR(name,type) type name;
251	# include "state.h"	254	# include "state.h"
252	#undef VAR	255	#undef VAR
253	} perl_slots;	256	} perl_slots;
254		257
…		…
257	/* this is a structure representing a perl-level coroutine */	260	/* this is a structure representing a perl-level coroutine */
258	struct coro {	261	struct coro {
259	/* the C coroutine allocated to this perl coroutine, if any */	262	/* the C coroutine allocated to this perl coroutine, if any */
260	coro_cctx *cctx;	263	coro_cctx *cctx;
261		264
262	/* process data */	265	/* state data */
263	struct CoroSLF slf_frame; /* saved slf frame */	266	struct CoroSLF slf_frame; /* saved slf frame */
264	AV *mainstack;	267	AV *mainstack;
265	perl_slots slot; / basically the saved sp */	268	perl_slots slot; / basically the saved sp */
266		269
		270	CV startcv; / the CV to execute */
267	AV args; / data associated with this coroutine (initial args) */	271	AV args; / data associated with this coroutine (initial args) */
268	int refcnt; /* coroutines are refcounted, yes */	272	int refcnt; /* coroutines are refcounted, yes */
269	int flags; /* CF_ flags */	273	int flags; /* CF_ flags */
270	HV hv; / the perl hash associated with this coro, if any */	274	HV hv; / the perl hash associated with this coro, if any */
		275	void (on_destroy)(pTHX_ struct coro coro);
271		276
272	/* statistics */	277	/* statistics */
273	int usecount; /* number of transfers to this coro */	278	int usecount; /* number of transfers to this coro */
274		279
275	/* coro process data */	280	/* coro process data */
276	int prio;	281	int prio;
277	SV throw; / exception to be thrown */	282	SV except; / exception to be thrown */
		283	SV *rouse_cb;
278		284
279	/* async_pool */	285	/* async_pool */
280	SV *saved_deffh;	286	SV *saved_deffh;
		287	SV *invoke_cb;
		288	AV *invoke_av;
281		289
282	/* linked list */	290	/* linked list */
283	struct coro next, prev;	291	struct coro next, prev;
284	};	292	};
285		293
286	typedef struct coro *Coro__State;	294	typedef struct coro *Coro__State;
287	typedef struct coro *Coro__State_or_hashref;	295	typedef struct coro *Coro__State_or_hashref;
288		296
		297	/* the following variables are effectively part of the perl context */
		298	/* and get copied between struct coro and these variables */
		299	/* the mainr easonw e don't support windows process emulation */
289	static struct CoroSLF slf_frame; /* the current slf frame */	300	static struct CoroSLF slf_frame; /* the current slf frame */
290		301
291	/ Coro ******************************************************************/	302	/ Coro ******************************************************************/
292		303
293	#define PRIO_MAX 3	304	#define PRIO_MAX 3
…		…
299		310
300	/* for Coro.pm */	311	/* for Coro.pm */
301	static SV *coro_current;	312	static SV *coro_current;
302	static SV *coro_readyhook;	313	static SV *coro_readyhook;
303	static AV *coro_ready [PRIO_MAX - PRIO_MIN + 1];	314	static AV *coro_ready [PRIO_MAX - PRIO_MIN + 1];
		315	static CV cv_coro_run, cv_coro_terminate;
304	static struct coro *coro_first;	316	static struct coro *coro_first;
305	#define coro_nready coroapi.nready	317	#define coro_nready coroapi.nready
306		318
307	/ lowlevel stuff ********************************************************/	319	/ lowlevel stuff ********************************************************/
308		320
…		…
334	get_hv (name, create);	346	get_hv (name, create);
335	#endif	347	#endif
336	return get_hv (name, create);	348	return get_hv (name, create);
337	}	349	}
338		350
		351	/* may croak */
		352	INLINE CV *
		353	coro_sv_2cv (pTHX_ SV *sv)
		354	{
		355	HV *st;
		356	GV *gvp;
		357	return sv_2cv (sv, &st, &gvp, 0);
		358	}
		359
		360	/*****************************************************************************/
		361	/* magic glue */
		362
		363	#define CORO_MAGIC_type_cv 26
		364	#define CORO_MAGIC_type_state PERL_MAGIC_ext
		365
		366	#define CORO_MAGIC_NN(sv, type) \
		367	(expect_true (SvMAGIC (sv)->mg_type == type) \
		368	? SvMAGIC (sv) \
		369	: mg_find (sv, type))
		370
		371	#define CORO_MAGIC(sv, type) \
		372	(expect_true (SvMAGIC (sv)) \
		373	? CORO_MAGIC_NN (sv, type) \
		374	: 0)
		375
		376	#define CORO_MAGIC_cv(cv) CORO_MAGIC (((SV *)(cv)), CORO_MAGIC_type_cv)
		377	#define CORO_MAGIC_state(sv) CORO_MAGIC_NN (((SV *)(sv)), CORO_MAGIC_type_state)
		378
		379	INLINE struct coro *
		380	SvSTATE_ (pTHX_ SV *coro)
		381	{
		382	HV *stash;
		383	MAGIC *mg;
		384
		385	if (SvROK (coro))
		386	coro = SvRV (coro);
		387
		388	if (expect_false (SvTYPE (coro) != SVt_PVHV))
		389	croak ("Coro::State object required");
		390
		391	stash = SvSTASH (coro);
		392	if (expect_false (stash != coro_stash && stash != coro_state_stash))
		393	{
		394	/* very slow, but rare, check */
		395	if (!sv_derived_from (sv_2mortal (newRV_inc (coro)), "Coro::State"))
		396	croak ("Coro::State object required");
		397	}
		398
		399	mg = CORO_MAGIC_state (coro);
		400	return (struct coro *)mg->mg_ptr;
		401	}
		402
		403	#define SvSTATE(sv) SvSTATE_ (aTHX_ (sv))
		404
		405	/* faster than SvSTATE, but expects a coroutine hv */
		406	#define SvSTATE_hv(hv) ((struct coro )CORO_MAGIC_NN ((SV )hv, CORO_MAGIC_type_state)->mg_ptr)
		407	#define SvSTATE_current SvSTATE_hv (SvRV (coro_current))
		408
		409	/*****************************************************************************/
		410	/* padlist management and caching */
		411
339	static AV *	412	static AV *
340	coro_clone_padlist (pTHX_ CV *cv)	413	coro_derive_padlist (pTHX_ CV *cv)
341	{	414	{
342	AV *padlist = CvPADLIST (cv);	415	AV *padlist = CvPADLIST (cv);
343	AV newpadlist, newpad;	416	AV newpadlist, newpad;
344		417
345	newpadlist = newAV ();	418	newpadlist = newAV ();
…		…
350	Perl_pad_push (aTHX_ padlist, AvFILLp (padlist) + 1, 1);	423	Perl_pad_push (aTHX_ padlist, AvFILLp (padlist) + 1, 1);
351	#endif	424	#endif
352	newpad = (AV *)AvARRAY (padlist)[AvFILLp (padlist)];	425	newpad = (AV *)AvARRAY (padlist)[AvFILLp (padlist)];
353	--AvFILLp (padlist);	426	--AvFILLp (padlist);
354		427
355	av_store (newpadlist, 0, SvREFCNT_inc_NN (*av_fetch (padlist, 0, FALSE)));	428	av_store (newpadlist, 0, SvREFCNT_inc_NN (AvARRAY (padlist)[0]));
356	av_store (newpadlist, 1, (SV *)newpad);	429	av_store (newpadlist, 1, (SV *)newpad);
357		430
358	return newpadlist;	431	return newpadlist;
359	}	432	}
360		433
361	static void	434	static void
362	free_padlist (pTHX_ AV *padlist)	435	free_padlist (pTHX_ AV *padlist)
363	{	436	{
364	/* may be during global destruction */	437	/* may be during global destruction */
365	if (SvREFCNT (padlist))	438	if (!IN_DESTRUCT)
366	{	439	{
367	I32 i = AvFILLp (padlist);	440	I32 i = AvFILLp (padlist);
368	while (i >= 0)	441
		442	while (i > 0) /* special-case index 0 */
369	{	443	{
370	SV **svp = av_fetch (padlist, i--, FALSE);	444	/* we try to be extra-careful here */
371	if (svp)	445	AV av = (AV )AvARRAY (padlist)[i--];
372	{	446	I32 j = AvFILLp (av);
373	SV *sv;	447
374	while (&PL_sv_undef != (sv = av_pop ((AV )svp)))	448	while (j >= 0)
		449	SvREFCNT_dec (AvARRAY (av)[j--]);
		450
		451	AvFILLp (av) = -1;
375	SvREFCNT_dec (sv);	452	SvREFCNT_dec (av);
376
377	SvREFCNT_dec (*svp);
378	}
379	}	453	}
380		454
		455	SvREFCNT_dec (AvARRAY (padlist)[0]);
		456
		457	AvFILLp (padlist) = -1;
381	SvREFCNT_dec ((SV*)padlist);	458	SvREFCNT_dec ((SV*)padlist);
382	}	459	}
383	}	460	}
384		461
385	static int	462	static int
…		…
394		471
395	SvREFCNT_dec (av); /* sv_magicext increased the refcount */	472	SvREFCNT_dec (av); /* sv_magicext increased the refcount */
396		473
397	return 0;	474	return 0;
398	}	475	}
399
400	#define CORO_MAGIC_type_cv PERL_MAGIC_ext
401	#define CORO_MAGIC_type_state PERL_MAGIC_ext
402		476
403	static MGVTBL coro_cv_vtbl = {	477	static MGVTBL coro_cv_vtbl = {
404	0, 0, 0, 0,	478	0, 0, 0, 0,
405	coro_cv_free	479	coro_cv_free
406	};	480	};
407
408	#define CORO_MAGIC(sv, type) \
409	SvMAGIC (sv) \
410	? SvMAGIC (sv)->mg_type == type \
411	? SvMAGIC (sv) \
412	: mg_find (sv, type) \
413	: 0
414
415	#define CORO_MAGIC_cv(cv) CORO_MAGIC (((SV *)(cv)), CORO_MAGIC_type_cv)
416	#define CORO_MAGIC_state(sv) CORO_MAGIC (((SV *)(sv)), CORO_MAGIC_type_state)
417
418	INLINE struct coro *
419	SvSTATE_ (pTHX_ SV *coro)
420	{
421	HV *stash;
422	MAGIC *mg;
423
424	if (SvROK (coro))
425	coro = SvRV (coro);
426
427	if (expect_false (SvTYPE (coro) != SVt_PVHV))
428	croak ("Coro::State object required");
429
430	stash = SvSTASH (coro);
431	if (expect_false (stash != coro_stash && stash != coro_state_stash))
432	{
433	/* very slow, but rare, check */
434	if (!sv_derived_from (sv_2mortal (newRV_inc (coro)), "Coro::State"))
435	croak ("Coro::State object required");
436	}
437
438	mg = CORO_MAGIC_state (coro);
439	return (struct coro *)mg->mg_ptr;
440	}
441
442	#define SvSTATE(sv) SvSTATE_ (aTHX_ (sv))
443		481
444	/* the next two functions merely cache the padlists */	482	/* the next two functions merely cache the padlists */
445	static void	483	static void
446	get_padlist (pTHX_ CV *cv)	484	get_padlist (pTHX_ CV *cv)
447	{	485	{
…		…
453	else	491	else
454	{	492	{
455	#if CORO_PREFER_PERL_FUNCTIONS	493	#if CORO_PREFER_PERL_FUNCTIONS
456	/* this is probably cleaner? but also slower! */	494	/* this is probably cleaner? but also slower! */
457	/* in practise, it seems to be less stable */	495	/* in practise, it seems to be less stable */
458	CV *cp = Perl_cv_clone (cv);	496	CV *cp = Perl_cv_clone (aTHX_ cv);
459	CvPADLIST (cv) = CvPADLIST (cp);	497	CvPADLIST (cv) = CvPADLIST (cp);
460	CvPADLIST (cp) = 0;	498	CvPADLIST (cp) = 0;
461	SvREFCNT_dec (cp);	499	SvREFCNT_dec (cp);
462	#else	500	#else
463	CvPADLIST (cv) = coro_clone_padlist (aTHX_ cv);	501	CvPADLIST (cv) = coro_derive_padlist (aTHX_ cv);
464	#endif	502	#endif
465	}	503	}
466	}	504	}
467		505
468	static void	506	static void
…		…
475	mg = sv_magicext ((SV )cv, (SV )newAV (), CORO_MAGIC_type_cv, &coro_cv_vtbl, 0, 0);	513	mg = sv_magicext ((SV )cv, (SV )newAV (), CORO_MAGIC_type_cv, &coro_cv_vtbl, 0, 0);
476		514
477	av = (AV *)mg->mg_obj;	515	av = (AV *)mg->mg_obj;
478		516
479	if (expect_false (AvFILLp (av) >= AvMAX (av)))	517	if (expect_false (AvFILLp (av) >= AvMAX (av)))
480	av_extend (av, AvMAX (av) + 1);	518	av_extend (av, AvFILLp (av) + 1);
481		519
482	AvARRAY (av)[++AvFILLp (av)] = (SV *)CvPADLIST (cv);	520	AvARRAY (av)[++AvFILLp (av)] = (SV *)CvPADLIST (cv);
483	}	521	}
484		522
485	/ load & save, init *****************************************************/	523	/ load & save, init *****************************************************/
…		…
490	perl_slots *slot = c->slot;	528	perl_slots *slot = c->slot;
491	c->slot = 0;	529	c->slot = 0;
492		530
493	PL_mainstack = c->mainstack;	531	PL_mainstack = c->mainstack;
494		532
495	GvSV (PL_defgv) = slot->defsv;	533	GvSV (PL_defgv) = slot->defsv;
496	GvAV (PL_defgv) = slot->defav;	534	GvAV (PL_defgv) = slot->defav;
497	GvSV (PL_errgv) = slot->errsv;	535	GvSV (PL_errgv) = slot->errsv;
498	GvSV (irsgv) = slot->irsgv;	536	GvSV (irsgv) = slot->irsgv;
		537	GvHV (PL_hintgv) = slot->hinthv;
499		538
500	#define VAR(name,type) PL_ ## name = slot->name;	539	#define VAR(name,type) PL_ ## name = slot->name;
501	# include "state.h"	540	# include "state.h"
502	#undef VAR	541	#undef VAR
503		542
…		…
515	}	554	}
516		555
517	PUTBACK;	556	PUTBACK;
518	}	557	}
519		558
520	slf_frame = c->slf_frame;	559	slf_frame = c->slf_frame;
		560	CORO_THROW = c->except;
521	}	561	}
522		562
523	static void	563	static void
524	save_perl (pTHX_ Coro__State c)	564	save_perl (pTHX_ Coro__State c)
525	{	565	{
		566	c->except = CORO_THROW;
526	c->slf_frame = slf_frame;	567	c->slf_frame = slf_frame;
527		568
528	{	569	{
529	dSP;	570	dSP;
530	I32 cxix = cxstack_ix;	571	I32 cxix = cxstack_ix;
…		…
587	c->mainstack = PL_mainstack;	628	c->mainstack = PL_mainstack;
588		629
589	{	630	{
590	perl_slots slot = c->slot = (perl_slots )(cxstack + cxstack_ix + 1);	631	perl_slots slot = c->slot = (perl_slots )(cxstack + cxstack_ix + 1);
591		632
592	slot->defav = GvAV (PL_defgv);	633	slot->defav = GvAV (PL_defgv);
593	slot->defsv = DEFSV;	634	slot->defsv = DEFSV;
594	slot->errsv = ERRSV;	635	slot->errsv = ERRSV;
595	slot->irsgv = GvSV (irsgv);	636	slot->irsgv = GvSV (irsgv);
		637	slot->hinthv = GvHV (PL_hintgv);
596		638
597	#define VAR(name,type) slot->name = PL_ ## name;	639	#define VAR(name,type) slot->name = PL_ ## name;
598	# include "state.h"	640	# include "state.h"
599	#undef VAR	641	#undef VAR
600	}	642	}
…		…
605	* of perl.c:init_stacks, except that it uses less memory	647	* of perl.c:init_stacks, except that it uses less memory
606	* on the (sometimes correct) assumption that coroutines do	648	* on the (sometimes correct) assumption that coroutines do
607	* not usually need a lot of stackspace.	649	* not usually need a lot of stackspace.
608	*/	650	*/
609	#if CORO_PREFER_PERL_FUNCTIONS	651	#if CORO_PREFER_PERL_FUNCTIONS
610	# define coro_init_stacks init_stacks	652	# define coro_init_stacks(thx) init_stacks ()
611	#else	653	#else
612	static void	654	static void
613	coro_init_stacks (pTHX)	655	coro_init_stacks (pTHX)
614	{	656	{
615	PL_curstackinfo = new_stackinfo(32, 8);	657	PL_curstackinfo = new_stackinfo(32, 8);
…		…
678	#if !PERL_VERSION_ATLEAST (5,10,0)	720	#if !PERL_VERSION_ATLEAST (5,10,0)
679	Safefree (PL_retstack);	721	Safefree (PL_retstack);
680	#endif	722	#endif
681	}	723	}
682		724
		725	#define CORO_RSS \
		726	rss += sizeof (SYM (curstackinfo)); \
		727	rss += (SYM (curstackinfo->si_cxmax) + 1) * sizeof (PERL_CONTEXT); \
		728	rss += sizeof (SV) + sizeof (struct xpvav) + (1 + AvMAX (SYM (curstack))) * sizeof (SV *); \
		729	rss += SYM (tmps_max) * sizeof (SV *); \
		730	rss += (SYM (markstack_max) - SYM (markstack_ptr)) * sizeof (I32); \
		731	rss += SYM (scopestack_max) * sizeof (I32); \
		732	rss += SYM (savestack_max) * sizeof (ANY);
		733
683	static size_t	734	static size_t
684	coro_rss (pTHX_ struct coro *coro)	735	coro_rss (pTHX_ struct coro *coro)
685	{	736	{
686	size_t rss = sizeof (*coro);	737	size_t rss = sizeof (*coro);
687		738
688	if (coro->mainstack)	739	if (coro->mainstack)
689	{	740	{
690	perl_slots tmp_slot;
691	perl_slots *slot;
692
693	if (coro->flags & CF_RUNNING)	741	if (coro->flags & CF_RUNNING)
694	{	742	{
695	slot = &tmp_slot;	743	#define SYM(sym) PL_ ## sym
696		744	CORO_RSS;
697	#define VAR(name,type) slot->name = PL_ ## name;
698	# include "state.h"
699	#undef VAR	745	#undef SYM
700	}	746	}
701	else	747	else
702	slot = coro->slot;
703
704	if (slot)
705	{	748	{
706	rss += sizeof (slot->curstackinfo);	749	#define SYM(sym) coro->slot->sym
707	rss += (slot->curstackinfo->si_cxmax + 1) * sizeof (PERL_CONTEXT);	750	CORO_RSS;
708	rss += sizeof (SV) + sizeof (struct xpvav) + (1 + AvMAX (slot->curstack)) * sizeof (SV *);	751	#undef SYM
709	rss += slot->tmps_max * sizeof (SV *);
710	rss += (slot->markstack_max - slot->markstack_ptr) * sizeof (I32);
711	rss += slot->scopestack_max * sizeof (I32);
712	rss += slot->savestack_max * sizeof (ANY);
713
714	#if !PERL_VERSION_ATLEAST (5,10,0)
715	rss += slot->retstack_max * sizeof (OP *);
716	#endif
717	}	752	}
718	}	753	}
719		754
720	return rss;	755	return rss;
721	}	756	}
…		…
823	slf_check_nop (pTHX_ struct CoroSLF *frame)	858	slf_check_nop (pTHX_ struct CoroSLF *frame)
824	{	859	{
825	return 0;	860	return 0;
826	}	861	}
827		862
828	static void	863	static int
		864	slf_check_repeat (pTHX_ struct CoroSLF *frame)
		865	{
		866	return 1;
		867	}
		868
		869	static UNOP coro_setup_op;
		870
		871	static void NOINLINE /* noinline to keep it out of the transfer fast path */
829	coro_setup (pTHX_ struct coro *coro)	872	coro_setup (pTHX_ struct coro *coro)
830	{	873	{
831	/*	874	/*
832	* emulate part of the perl startup here.	875	* emulate part of the perl startup here.
833	*/	876	*/
…		…
835		878
836	PL_runops = RUNOPS_DEFAULT;	879	PL_runops = RUNOPS_DEFAULT;
837	PL_curcop = &PL_compiling;	880	PL_curcop = &PL_compiling;
838	PL_in_eval = EVAL_NULL;	881	PL_in_eval = EVAL_NULL;
839	PL_comppad = 0;	882	PL_comppad = 0;
		883	PL_comppad_name = 0;
		884	PL_comppad_name_fill = 0;
		885	PL_comppad_name_floor = 0;
840	PL_curpm = 0;	886	PL_curpm = 0;
841	PL_curpad = 0;	887	PL_curpad = 0;
842	PL_localizing = 0;	888	PL_localizing = 0;
843	PL_dirty = 0;	889	PL_dirty = 0;
844	PL_restartop = 0;	890	PL_restartop = 0;
845	#if PERL_VERSION_ATLEAST (5,10,0)	891	#if PERL_VERSION_ATLEAST (5,10,0)
846	PL_parser = 0;	892	PL_parser = 0;
847	#endif	893	#endif
		894	PL_hints = 0;
848		895
849	/* recreate the die/warn hooks */	896	/* recreate the die/warn hooks */
850	PL_diehook = 0; SvSetMagicSV (*hv_fetch (hv_sig, "__DIE__" , sizeof ("__DIE__" ) - 1, 1), rv_diehook );	897	PL_diehook = 0; SvSetMagicSV (*hv_fetch (hv_sig, "__DIE__" , sizeof ("__DIE__" ) - 1, 1), rv_diehook );
851	PL_warnhook = 0; SvSetMagicSV (*hv_fetch (hv_sig, "__WARN__", sizeof ("__WARN__") - 1, 1), rv_warnhook);	898	PL_warnhook = 0; SvSetMagicSV (*hv_fetch (hv_sig, "__WARN__", sizeof ("__WARN__") - 1, 1), rv_warnhook);
852		899
853	GvSV (PL_defgv) = newSV (0);	900	GvSV (PL_defgv) = newSV (0);
854	GvAV (PL_defgv) = coro->args; coro->args = 0;	901	GvAV (PL_defgv) = coro->args; coro->args = 0;
855	GvSV (PL_errgv) = newSV (0);	902	GvSV (PL_errgv) = newSV (0);
856	GvSV (irsgv) = newSVpvn ("\n", 1); sv_magic (GvSV (irsgv), (SV *)irsgv, PERL_MAGIC_sv, "/", 0);	903	GvSV (irsgv) = newSVpvn ("\n", 1); sv_magic (GvSV (irsgv), (SV *)irsgv, PERL_MAGIC_sv, "/", 0);
		904	GvHV (PL_hintgv) = 0;
857	PL_rs = newSVsv (GvSV (irsgv));	905	PL_rs = newSVsv (GvSV (irsgv));
858	PL_defoutgv = (GV *)SvREFCNT_inc_NN (stdoutgv);	906	PL_defoutgv = (GV *)SvREFCNT_inc_NN (stdoutgv);
859		907
860	{	908	{
861	dSP;	909	dSP;
862	UNOP myop;	910	UNOP myop;
863		911
864	Zero (&myop, 1, UNOP);	912	Zero (&myop, 1, UNOP);
865	myop.op_next = Nullop;	913	myop.op_next = Nullop;
		914	myop.op_type = OP_ENTERSUB;
866	myop.op_flags = OPf_WANT_VOID;	915	myop.op_flags = OPf_WANT_VOID;
867		916
868	PUSHMARK (SP);	917	PUSHMARK (SP);
869	XPUSHs (sv_2mortal (av_shift (GvAV (PL_defgv))));	918	PUSHs ((SV *)coro->startcv);
870	PUTBACK;	919	PUTBACK;
871	PL_op = (OP *)&myop;	920	PL_op = (OP *)&myop;
872	PL_op = PL_ppaddr[OP_ENTERSUB](aTHX);	921	PL_op = PL_ppaddr[OP_ENTERSUB](aTHX);
873	SPAGAIN;
874	}	922	}
875		923
876	/* this newly created coroutine might be run on an existing cctx which most	924	/* this newly created coroutine might be run on an existing cctx which most
877	* likely was suspended in pp_slf, so we have to emulate entering pp_slf here.	925	* likely was suspended in pp_slf, so we have to emulate entering pp_slf here.
878	*/	926	*/
879	slf_frame.prepare = prepare_nop; /* provide a nop function for an eventual pp_slf */	927	slf_frame.prepare = prepare_nop; /* provide a nop function for an eventual pp_slf */
880	slf_frame.check = slf_check_nop; /* signal pp_slf to not repeat */	928	slf_frame.check = slf_check_nop; /* signal pp_slf to not repeat */
881	}
882		929
		930	/* and we have to provide the pp_slf op in any case, so pp_slf can skip it */
		931	coro_setup_op.op_next = PL_op;
		932	coro_setup_op.op_type = OP_ENTERSUB;
		933	coro_setup_op.op_ppaddr = pp_slf;
		934	/* no flags etc. required, as an init function won't be called */
		935
		936	PL_op = (OP *)&coro_setup_op;
		937
		938	/* copy throw, in case it was set before coro_setup */
		939	CORO_THROW = coro->except;
		940	}
		941
883	static void	942	static void
884	coro_destruct (pTHX_ struct coro *coro)	943	coro_unwind_stacks (pTHX)
885	{	944	{
886	if (!IN_DESTRUCT)	945	if (!IN_DESTRUCT)
887	{	946	{
888	/* restore all saved variables and stuff */	947	/* restore all saved variables and stuff */
889	LEAVE_SCOPE (0);	948	LEAVE_SCOPE (0);
…		…
897	POPSTACK_TO (PL_mainstack);	956	POPSTACK_TO (PL_mainstack);
898		957
899	/* unwind main stack */	958	/* unwind main stack */
900	dounwind (-1);	959	dounwind (-1);
901	}	960	}
		961	}
		962
		963	static void
		964	coro_destruct_perl (pTHX_ struct coro *coro)
		965	{
		966	coro_unwind_stacks (aTHX);
902		967
903	SvREFCNT_dec (GvSV (PL_defgv));	968	SvREFCNT_dec (GvSV (PL_defgv));
904	SvREFCNT_dec (GvAV (PL_defgv));	969	SvREFCNT_dec (GvAV (PL_defgv));
905	SvREFCNT_dec (GvSV (PL_errgv));	970	SvREFCNT_dec (GvSV (PL_errgv));
906	SvREFCNT_dec (PL_defoutgv);	971	SvREFCNT_dec (PL_defoutgv);
907	SvREFCNT_dec (PL_rs);	972	SvREFCNT_dec (PL_rs);
908	SvREFCNT_dec (GvSV (irsgv));	973	SvREFCNT_dec (GvSV (irsgv));
		974	SvREFCNT_dec (GvHV (PL_hintgv));
909		975
910	SvREFCNT_dec (PL_diehook);	976	SvREFCNT_dec (PL_diehook);
911	SvREFCNT_dec (PL_warnhook);	977	SvREFCNT_dec (PL_warnhook);
912		978
913	SvREFCNT_dec (coro->saved_deffh);	979	SvREFCNT_dec (coro->saved_deffh);
914	SvREFCNT_dec (coro->throw);	980	SvREFCNT_dec (coro->rouse_cb);
		981	SvREFCNT_dec (coro->invoke_cb);
		982	SvREFCNT_dec (coro->invoke_av);
915		983
916	coro_destruct_stacks (aTHX);	984	coro_destruct_stacks (aTHX);
917	}	985	}
918		986
919	INLINE void	987	INLINE void
…		…
929	static int	997	static int
930	runops_trace (pTHX)	998	runops_trace (pTHX)
931	{	999	{
932	COP *oldcop = 0;	1000	COP *oldcop = 0;
933	int oldcxix = -2;	1001	int oldcxix = -2;
934	struct coro coro = SvSTATE (coro_current); / trace cctx is tied to specific coro */
935	coro_cctx *cctx = coro->cctx;
936		1002
937	while ((PL_op = CALL_FPTR (PL_op->op_ppaddr) (aTHX)))	1003	while ((PL_op = CALL_FPTR (PL_op->op_ppaddr) (aTHX)))
938	{	1004	{
939	PERL_ASYNC_CHECK ();	1005	PERL_ASYNC_CHECK ();
940		1006
941	if (cctx->flags & CC_TRACE_ALL)	1007	if (cctx_current->flags & CC_TRACE_ALL)
942	{	1008	{
943	if (PL_op->op_type == OP_LEAVESUB && cctx->flags & CC_TRACE_SUB)	1009	if (PL_op->op_type == OP_LEAVESUB && cctx_current->flags & CC_TRACE_SUB)
944	{	1010	{
945	PERL_CONTEXT *cx = &cxstack[cxstack_ix];	1011	PERL_CONTEXT *cx = &cxstack[cxstack_ix];
946	SV bot, top;	1012	SV bot, top;
947	AV av = newAV (); / return values */	1013	AV av = newAV (); / return values */
948	SV **cb;	1014	SV **cb;
…		…
985		1051
986	if (PL_curcop != &PL_compiling)	1052	if (PL_curcop != &PL_compiling)
987	{	1053	{
988	SV **cb;	1054	SV **cb;
989		1055
990	if (oldcxix != cxstack_ix && cctx->flags & CC_TRACE_SUB)	1056	if (oldcxix != cxstack_ix && cctx_current->flags & CC_TRACE_SUB)
991	{	1057	{
992	PERL_CONTEXT *cx = &cxstack[cxstack_ix];	1058	PERL_CONTEXT *cx = &cxstack[cxstack_ix];
993		1059
994	if (CxTYPE (cx) == CXt_SUB && oldcxix < cxstack_ix)	1060	if (CxTYPE (cx) == CXt_SUB && oldcxix < cxstack_ix)
995	{	1061	{
996	runops_proc_t old_runops = PL_runops;
997	dSP;	1062	dSP;
998	GV *gv = CvGV (cx->blk_sub.cv);	1063	GV *gv = CvGV (cx->blk_sub.cv);
999	SV *fullname = sv_2mortal (newSV (0));	1064	SV *fullname = sv_2mortal (newSV (0));
1000		1065
1001	if (isGV (gv))	1066	if (isGV (gv))
…		…
1006	SAVETMPS;	1071	SAVETMPS;
1007	EXTEND (SP, 3);	1072	EXTEND (SP, 3);
1008	PUSHMARK (SP);	1073	PUSHMARK (SP);
1009	PUSHs (&PL_sv_yes);	1074	PUSHs (&PL_sv_yes);
1010	PUSHs (fullname);	1075	PUSHs (fullname);
1011	PUSHs (CxHASARGS (cx) ? sv_2mortal (newRV_inc ((SV *)cx->blk_sub.argarray)) : &PL_sv_undef);	1076	PUSHs (CxHASARGS (cx) ? sv_2mortal (newRV_inc ((SV *)cx->blk_sub.argarray)) : &PL_sv_undef);
1012	PUTBACK;	1077	PUTBACK;
1013	cb = hv_fetch ((HV *)SvRV (coro_current), "_trace_sub_cb", sizeof ("_trace_sub_cb") - 1, 0);	1078	cb = hv_fetch ((HV *)SvRV (coro_current), "_trace_sub_cb", sizeof ("_trace_sub_cb") - 1, 0);
1014	if (cb) call_sv (*cb, G_KEEPERR \| G_EVAL \| G_VOID \| G_DISCARD);	1079	if (cb) call_sv (*cb, G_KEEPERR \| G_EVAL \| G_VOID \| G_DISCARD);
1015	SPAGAIN;	1080	SPAGAIN;
1016	FREETMPS;	1081	FREETMPS;
…		…
1019	}	1084	}
1020		1085
1021	oldcxix = cxstack_ix;	1086	oldcxix = cxstack_ix;
1022	}	1087	}
1023		1088
1024	if (cctx->flags & CC_TRACE_LINE)	1089	if (cctx_current->flags & CC_TRACE_LINE)
1025	{	1090	{
1026	dSP;	1091	dSP;
1027		1092
1028	PL_runops = RUNOPS_DEFAULT;	1093	PL_runops = RUNOPS_DEFAULT;
1029	ENTER;	1094	ENTER;
…		…
1048		1113
1049	TAINT_NOT;	1114	TAINT_NOT;
1050	return 0;	1115	return 0;
1051	}	1116	}
1052		1117
		1118	static struct CoroSLF cctx_ssl_frame;
		1119
1053	static void	1120	static void
1054	prepare_set_stacklevel (struct coro_transfer_args ta, struct coro_cctx cctx)	1121	slf_prepare_set_stacklevel (pTHX_ struct coro_transfer_args *ta)
1055	{	1122	{
1056	ta->prev = (struct coro *)cctx;
1057	ta->next = 0;	1123	ta->prev = 0;
1058	}	1124	}
1059		1125
1060	/* inject a fake call to Coro::State::_cctx_init into the execution */	1126	static int
1061	/* _cctx_init should be careful, as it could be called at almost any time */	1127	slf_check_set_stacklevel (pTHX_ struct CoroSLF *frame)
1062	/* during execution of a perl program */	1128	{
1063	/* also initialises PL_top_env */	1129	*frame = cctx_ssl_frame;
		1130
		1131	return frame->check (aTHX_ frame); /* execute the restored frame - there must be one */
		1132	}
		1133
		1134	/* initialises PL_top_env and injects a pseudo-slf-call to set the stacklevel */
1064	static void NOINLINE	1135	static void NOINLINE
1065	cctx_prepare (pTHX_ coro_cctx *cctx)	1136	cctx_prepare (pTHX)
1066	{	1137	{
1067	dSP;
1068	UNOP myop;
1069
1070	PL_top_env = &PL_start_env;	1138	PL_top_env = &PL_start_env;
1071		1139
1072	if (cctx->flags & CC_TRACE)	1140	if (cctx_current->flags & CC_TRACE)
1073	PL_runops = runops_trace;	1141	PL_runops = runops_trace;
1074		1142
1075	Zero (&myop, 1, UNOP);	1143	/* we already must be executing an SLF op, there is no other valid way
1076	myop.op_next = PL_op;	1144	* that can lead to creation of a new cctx */
1077	myop.op_flags = OPf_WANT_VOID \| OPf_STACKED;	1145	assert (("FATAL: can't prepare slf-less cctx in Coro module (please report)",
		1146	slf_frame.prepare && PL_op->op_ppaddr == pp_slf));
1078		1147
1079	PUSHMARK (SP);	1148	/* we must emulate leaving pp_slf, which is done inside slf_check_set_stacklevel */
1080	EXTEND (SP, 2);	1149	cctx_ssl_frame = slf_frame;
1081	PUSHs (sv_2mortal (newSViv ((IV)cctx)));	1150
1082	PUSHs ((SV *)get_cv ("Coro::State::_cctx_init", FALSE));	1151	slf_frame.prepare = slf_prepare_set_stacklevel;
1083	PUTBACK;	1152	slf_frame.check = slf_check_set_stacklevel;
1084	PL_op = (OP *)&myop;
1085	PL_op = PL_ppaddr[OP_ENTERSUB](aTHX);
1086	SPAGAIN;
1087	}	1153	}
1088		1154
1089	/* the tail of transfer: execute stuff we can only do after a transfer */	1155	/* the tail of transfer: execute stuff we can only do after a transfer */
1090	INLINE void	1156	INLINE void
1091	transfer_tail (pTHX)	1157	transfer_tail (pTHX)
1092	{	1158	{
1093	struct coro next = (struct coro )transfer_next;
1094	assert (!(transfer_next = 0)); /* just used for the side effect when asserts are enabled */
1095	assert (("FATAL: next coroutine was zero in transfer_tail (please report)", next));
1096
1097	free_coro_mortal (aTHX);	1159	free_coro_mortal (aTHX);
1098	UNLOCK;
1099
1100	if (expect_false (next->throw))
1101	{
1102	SV *exception = sv_2mortal (next->throw);
1103
1104	next->throw = 0;
1105	sv_setsv (ERRSV, exception);
1106	croak (0);
1107	}
1108	}	1160	}
1109		1161
1110	/*	1162	/*
1111	* this is a _very_ stripped down perl interpreter ;)	1163	* this is a _very_ stripped down perl interpreter ;)
1112	*/	1164	*/
…		…
1124	/* normally we would need to skip the entersub here */	1176	/* normally we would need to skip the entersub here */
1125	/* not doing so will re-execute it, which is exactly what we want */	1177	/* not doing so will re-execute it, which is exactly what we want */
1126	/* PL_nop = PL_nop->op_next */	1178	/* PL_nop = PL_nop->op_next */
1127		1179
1128	/* inject a fake subroutine call to cctx_init */	1180	/* inject a fake subroutine call to cctx_init */
1129	cctx_prepare (aTHX_ (coro_cctx *)arg);	1181	cctx_prepare (aTHX);
1130		1182
1131	/* cctx_run is the alternative tail of transfer() */	1183	/* cctx_run is the alternative tail of transfer() */
1132	/* TODO: throwing an exception here might be deadly, VERIFY */
1133	transfer_tail (aTHX);	1184	transfer_tail (aTHX);
1134		1185
1135	/* somebody or something will hit me for both perl_run and PL_restartop */	1186	/* somebody or something will hit me for both perl_run and PL_restartop */
1136	PL_restartop = PL_op;	1187	PL_restartop = PL_op;
1137	perl_run (PL_curinterp);	1188	perl_run (PL_curinterp);
		1189	/*
		1190	* Unfortunately, there is no way to get at the return values of the
		1191	* coro body here, as perl_run destroys these
		1192	*/
1138		1193
1139	/*	1194	/*
1140	* If perl-run returns we assume exit() was being called or the coro	1195	* If perl-run returns we assume exit() was being called or the coro
1141	* fell off the end, which seems to be the only valid (non-bug)	1196	* fell off the end, which seems to be the only valid (non-bug)
1142	* reason for perl_run to return. We try to exit by jumping to the	1197	* reason for perl_run to return. We try to exit by jumping to the
1143	* bootstrap-time "top" top_env, as we cannot restore the "main"	1198	* bootstrap-time "top" top_env, as we cannot restore the "main"
1144	* coroutine as Coro has no such concept	1199	* coroutine as Coro has no such concept.
		1200	* This actually isn't valid with the pthread backend, but OSes requiring
		1201	* that backend are too broken to do it in a standards-compliant way.
1145	*/	1202	*/
1146	PL_top_env = main_top_env;	1203	PL_top_env = main_top_env;
1147	JMPENV_JUMP (2); /* I do not feel well about the hardcoded 2 at all */	1204	JMPENV_JUMP (2); /* I do not feel well about the hardcoded 2 at all */
1148	}	1205	}
1149	}	1206	}
…		…
1226	cctx_destroy (coro_cctx *cctx)	1283	cctx_destroy (coro_cctx *cctx)
1227	{	1284	{
1228	if (!cctx)	1285	if (!cctx)
1229	return;	1286	return;
1230		1287
		1288	assert (("FATAL: tried to destroy current cctx", cctx != cctx_current));//D temporary?
		1289
1231	--cctx_count;	1290	--cctx_count;
1232	coro_destroy (&cctx->cctx);	1291	coro_destroy (&cctx->cctx);
1233		1292
1234	/* coro_transfer creates new, empty cctx's */	1293	/* coro_transfer creates new, empty cctx's */
1235	if (cctx->sptr)	1294	if (cctx->sptr)
…		…
1293	/ coroutine switching ***************************************************/	1352	/ coroutine switching ***************************************************/
1294		1353
1295	static void	1354	static void
1296	transfer_check (pTHX_ struct coro prev, struct coro next)	1355	transfer_check (pTHX_ struct coro prev, struct coro next)
1297	{	1356	{
		1357	/* TODO: throwing up here is considered harmful */
		1358
1298	if (expect_true (prev != next))	1359	if (expect_true (prev != next))
1299	{	1360	{
1300	if (expect_false (!(prev->flags & (CF_RUNNING \| CF_NEW))))	1361	if (expect_false (!(prev->flags & (CF_RUNNING \| CF_NEW))))
1301	croak ("Coro::State::transfer called with non-running/new prev Coro::State, but can only transfer from running or new states,");	1362	croak ("Coro::State::transfer called with a suspended prev Coro::State, but can only transfer from running or new states,");
1302		1363
1303	if (expect_false (next->flags & CF_RUNNING))	1364	if (expect_false (next->flags & CF_RUNNING))
1304	croak ("Coro::State::transfer called with running next Coro::State, but can only transfer to inactive states,");	1365	croak ("Coro::State::transfer called with running next Coro::State, but can only transfer to inactive states,");
1305		1366
1306	if (expect_false (next->flags & CF_DESTROYED))	1367	if (expect_false (next->flags & CF_DESTROYED))
…		…
1312	#endif	1373	#endif
1313	}	1374	}
1314	}	1375	}
1315		1376
1316	/* always use the TRANSFER macro */	1377	/* always use the TRANSFER macro */
1317	static void NOINLINE	1378	static void NOINLINE /* noinline so we have a fixed stackframe */
1318	transfer (pTHX_ struct coro prev, struct coro next, int force_cctx)	1379	transfer (pTHX_ struct coro prev, struct coro next, int force_cctx)
1319	{	1380	{
1320	dSTACKLEVEL;	1381	dSTACKLEVEL;
1321		1382
1322	/* sometimes transfer is only called to set idle_sp */	1383	/* sometimes transfer is only called to set idle_sp */
1323	if (expect_false (!next))	1384	if (expect_false (!prev))
1324	{	1385	{
1325	((coro_cctx )prev)->idle_sp = (void )stacklevel;	1386	cctx_current->idle_sp = STACKLEVEL;
1326	assert (((coro_cctx )prev)->idle_te = PL_top_env); / just for the side-effect when asserts are enabled */	1387	assert (cctx_current->idle_te = PL_top_env); /* just for the side-effect when asserts are enabled */
1327	}	1388	}
1328	else if (expect_true (prev != next))	1389	else if (expect_true (prev != next))
1329	{	1390	{
1330	coro_cctx *prev__cctx;	1391	coro_cctx *cctx_prev;
1331		1392
1332	if (expect_false (prev->flags & CF_NEW))	1393	if (expect_false (prev->flags & CF_NEW))
1333	{	1394	{
1334	/* create a new empty/source context */	1395	/* create a new empty/source context */
1335	prev->cctx = cctx_new_empty ();
1336	prev->flags &= ~CF_NEW;	1396	prev->flags &= ~CF_NEW;
1337	prev->flags \|= CF_RUNNING;	1397	prev->flags \|= CF_RUNNING;
1338	}	1398	}
1339		1399
1340	prev->flags &= ~CF_RUNNING;	1400	prev->flags &= ~CF_RUNNING;
1341	next->flags \|= CF_RUNNING;	1401	next->flags \|= CF_RUNNING;
1342
1343	LOCK;
1344		1402
1345	/* first get rid of the old state */	1403	/* first get rid of the old state */
1346	save_perl (aTHX_ prev);	1404	save_perl (aTHX_ prev);
1347		1405
1348	if (expect_false (next->flags & CF_NEW))	1406	if (expect_false (next->flags & CF_NEW))
…		…
1353	coro_setup (aTHX_ next);	1411	coro_setup (aTHX_ next);
1354	}	1412	}
1355	else	1413	else
1356	load_perl (aTHX_ next);	1414	load_perl (aTHX_ next);
1357		1415
1358	prev__cctx = prev->cctx;
1359
1360	/* possibly untie and reuse the cctx */	1416	/* possibly untie and reuse the cctx */
1361	if (expect_true (	1417	if (expect_true (
1362	prev__cctx->idle_sp == (void *)stacklevel	1418	cctx_current->idle_sp == STACKLEVEL
1363	&& !(prev__cctx->flags & CC_TRACE)	1419	&& !(cctx_current->flags & CC_TRACE)
1364	&& !force_cctx	1420	&& !force_cctx
1365	))	1421	))
1366	{	1422	{
1367	/* I assume that stacklevel is a stronger indicator than PL_top_env changes */	1423	/* I assume that stacklevel is a stronger indicator than PL_top_env changes */
1368	assert (("FATAL: current top_env must equal previous top_env in Coro (please report)", PL_top_env == prev__cctx->idle_te));	1424	assert (("FATAL: current top_env must equal previous top_env in Coro (please report)", PL_top_env == cctx_current->idle_te));
1369		1425
1370	prev->cctx = 0;
1371
1372	/* if the cctx is about to be destroyed we need to make sure we won't see it in cctx_get */	1426	/* if the cctx is about to be destroyed we need to make sure we won't see it in cctx_get. */
1373	/* without this the next cctx_get might destroy the prev__cctx while still in use */	1427	/* without this the next cctx_get might destroy the running cctx while still in use */
1374	if (expect_false (CCTX_EXPIRED (prev__cctx)))	1428	if (expect_false (CCTX_EXPIRED (cctx_current)))
1375	if (!next->cctx)	1429	if (expect_true (!next->cctx))
1376	next->cctx = cctx_get (aTHX);	1430	next->cctx = cctx_get (aTHX);
1377		1431
1378	cctx_put (prev__cctx);	1432	cctx_put (cctx_current);
1379	}	1433	}
		1434	else
		1435	prev->cctx = cctx_current;
1380		1436
1381	++next->usecount;	1437	++next->usecount;
1382		1438
1383	if (expect_true (!next->cctx))	1439	cctx_prev = cctx_current;
1384	next->cctx = cctx_get (aTHX);	1440	cctx_current = expect_false (next->cctx) ? next->cctx : cctx_get (aTHX);
1385		1441
1386	assert (("FATAL: transfer_next already nonzero in Coro (please report)", !transfer_next));	1442	next->cctx = 0;
1387	transfer_next = next;
1388		1443
1389	if (expect_false (prev__cctx != next->cctx))	1444	if (expect_false (cctx_prev != cctx_current))
1390	{	1445	{
1391	prev__cctx->top_env = PL_top_env;	1446	cctx_prev->top_env = PL_top_env;
1392	PL_top_env = next->cctx->top_env;	1447	PL_top_env = cctx_current->top_env;
1393	coro_transfer (&prev__cctx->cctx, &next->cctx->cctx);	1448	coro_transfer (&cctx_prev->cctx, &cctx_current->cctx);
1394	}	1449	}
1395		1450
1396	transfer_tail (aTHX);	1451	transfer_tail (aTHX);
1397	}	1452	}
1398	}	1453	}
…		…
1405	static int	1460	static int
1406	coro_state_destroy (pTHX_ struct coro *coro)	1461	coro_state_destroy (pTHX_ struct coro *coro)
1407	{	1462	{
1408	if (coro->flags & CF_DESTROYED)	1463	if (coro->flags & CF_DESTROYED)
1409	return 0;	1464	return 0;
		1465
		1466	if (coro->on_destroy)
		1467	coro->on_destroy (aTHX_ coro);
1410		1468
1411	coro->flags \|= CF_DESTROYED;	1469	coro->flags \|= CF_DESTROYED;
1412		1470
1413	if (coro->flags & CF_READY)	1471	if (coro->flags & CF_READY)
1414	{	1472	{
1415	/* reduce nready, as destroying a ready coro effectively unreadies it */	1473	/* reduce nready, as destroying a ready coro effectively unreadies it */
1416	/* alternative: look through all ready queues and remove the coro */	1474	/* alternative: look through all ready queues and remove the coro */
1417	LOCK;
1418	--coro_nready;	1475	--coro_nready;
1419	UNLOCK;
1420	}	1476	}
1421	else	1477	else
1422	coro->flags \|= CF_READY; /* make sure it is NOT put into the readyqueue */	1478	coro->flags \|= CF_READY; /* make sure it is NOT put into the readyqueue */
1423		1479
1424	if (coro->mainstack && coro->mainstack != main_mainstack)	1480	if (coro->mainstack
		1481	&& coro->mainstack != main_mainstack
		1482	&& coro->slot
		1483	&& !PL_dirty)
1425	{	1484	{
1426	struct coro temp;	1485	struct coro temp;
1427		1486
1428	assert (("FATAL: tried to destroy currently running coroutine (please report)", !(coro->flags & CF_RUNNING)));	1487	assert (("FATAL: tried to destroy currently running coroutine", coro->mainstack != PL_mainstack));
1429		1488
1430	save_perl (aTHX_ &temp);	1489	save_perl (aTHX_ &temp);
1431	load_perl (aTHX_ coro);	1490	load_perl (aTHX_ coro);
1432		1491
1433	coro_destruct (aTHX_ coro);	1492	coro_destruct_perl (aTHX_ coro);
1434		1493
1435	load_perl (aTHX_ &temp);	1494	load_perl (aTHX_ &temp);
1436		1495
1437	coro->slot = 0;	1496	coro->slot = 0;
1438	}	1497	}
1439		1498
1440	cctx_destroy (coro->cctx);	1499	cctx_destroy (coro->cctx);
		1500	SvREFCNT_dec (coro->startcv);
1441	SvREFCNT_dec (coro->args);	1501	SvREFCNT_dec (coro->args);
		1502	SvREFCNT_dec (CORO_THROW);
1442		1503
1443	if (coro->next) coro->next->prev = coro->prev;	1504	if (coro->next) coro->next->prev = coro->prev;
1444	if (coro->prev) coro->prev->next = coro->next;	1505	if (coro->prev) coro->prev->next = coro->next;
1445	if (coro == coro_first) coro_first = coro->next;	1506	if (coro == coro_first) coro_first = coro->next;
1446		1507
…		…
1500		1561
1501	prepare_transfer (aTHX_ &ta, prev_sv, next_sv);	1562	prepare_transfer (aTHX_ &ta, prev_sv, next_sv);
1502	TRANSFER (ta, 1);	1563	TRANSFER (ta, 1);
1503	}	1564	}
1504		1565
		1566	/*****************************************************************************/
		1567	/* gensub: simple closure generation utility */
		1568
		1569	#define GENSUB_ARG CvXSUBANY (cv).any_ptr
		1570
		1571	/* create a closure from XS, returns a code reference */
		1572	/* the arg can be accessed via GENSUB_ARG from the callback */
		1573	/* the callback must use dXSARGS/XSRETURN */
		1574	static SV *
		1575	gensub (pTHX_ void (xsub)(pTHX_ CV ), void *arg)
		1576	{
		1577	CV cv = (CV )newSV (0);
		1578
		1579	sv_upgrade ((SV *)cv, SVt_PVCV);
		1580
		1581	CvANON_on (cv);
		1582	CvISXSUB_on (cv);
		1583	CvXSUB (cv) = xsub;
		1584	GENSUB_ARG = arg;
		1585
		1586	return newRV_noinc ((SV *)cv);
		1587	}
		1588
1505	/ Coro ******************************************************************/	1589	/ Coro ******************************************************************/
1506		1590
1507	static void	1591	INLINE void
1508	coro_enq (pTHX_ SV *coro_sv)	1592	coro_enq (pTHX_ struct coro *coro)
1509	{	1593	{
1510	av_push (coro_ready [SvSTATE (coro_sv)->prio - PRIO_MIN], coro_sv);	1594	av_push (coro_ready [coro->prio - PRIO_MIN], SvREFCNT_inc_NN (coro->hv));
1511	}	1595	}
1512		1596
1513	static SV *	1597	INLINE SV *
1514	coro_deq (pTHX)	1598	coro_deq (pTHX)
1515	{	1599	{
1516	int prio;	1600	int prio;
1517		1601
1518	for (prio = PRIO_MAX - PRIO_MIN + 1; --prio >= 0; )	1602	for (prio = PRIO_MAX - PRIO_MIN + 1; --prio >= 0; )
…		…
1527	{	1611	{
1528	struct coro *coro;	1612	struct coro *coro;
1529	SV *sv_hook;	1613	SV *sv_hook;
1530	void (*xs_hook)(void);	1614	void (*xs_hook)(void);
1531		1615
1532	if (SvROK (coro_sv))
1533	coro_sv = SvRV (coro_sv);
1534
1535	coro = SvSTATE (coro_sv);	1616	coro = SvSTATE (coro_sv);
1536		1617
1537	if (coro->flags & CF_READY)	1618	if (coro->flags & CF_READY)
1538	return 0;	1619	return 0;
1539		1620
1540	coro->flags \|= CF_READY;	1621	coro->flags \|= CF_READY;
1541		1622
1542	LOCK;
1543
1544	sv_hook = coro_nready ? 0 : coro_readyhook;	1623	sv_hook = coro_nready ? 0 : coro_readyhook;
1545	xs_hook = coro_nready ? 0 : coroapi.readyhook;	1624	xs_hook = coro_nready ? 0 : coroapi.readyhook;
1546		1625
1547	coro_enq (aTHX_ SvREFCNT_inc_NN (coro_sv));	1626	coro_enq (aTHX_ coro);
1548	++coro_nready;	1627	++coro_nready;
1549		1628
1550	UNLOCK;
1551
1552	if (sv_hook)	1629	if (sv_hook)
1553	{	1630	{
1554	dSP;	1631	dSP;
1555		1632
1556	ENTER;	1633	ENTER;
1557	SAVETMPS;	1634	SAVETMPS;
1558		1635
1559	PUSHMARK (SP);	1636	PUSHMARK (SP);
1560	PUTBACK;	1637	PUTBACK;
1561	call_sv (sv_hook, G_DISCARD);	1638	call_sv (sv_hook, G_VOID \| G_DISCARD);
1562	SPAGAIN;
1563		1639
1564	FREETMPS;	1640	FREETMPS;
1565	LEAVE;	1641	LEAVE;
1566	}	1642	}
1567		1643
…		…
1575	api_is_ready (pTHX_ SV *coro_sv)	1651	api_is_ready (pTHX_ SV *coro_sv)
1576	{	1652	{
1577	return !!(SvSTATE (coro_sv)->flags & CF_READY);	1653	return !!(SvSTATE (coro_sv)->flags & CF_READY);
1578	}	1654	}
1579		1655
		1656	/* expects to own a reference to next->hv */
1580	INLINE void	1657	INLINE void
1581	prepare_schedule (pTHX_ struct coro_transfer_args *ta)	1658	prepare_schedule_to (pTHX_ struct coro_transfer_args ta, struct coro next)
1582	{	1659	{
1583	SV prev_sv, next_sv;
1584
1585	for (;;)
1586	{
1587	LOCK;
1588	next_sv = coro_deq (aTHX);
1589
1590	/* nothing to schedule: call the idle handler */
1591	if (expect_false (!next_sv))
1592	{
1593	dSP;
1594	UNLOCK;
1595
1596	ENTER;
1597	SAVETMPS;
1598
1599	PUSHMARK (SP);
1600	PUTBACK;
1601	call_sv (get_sv ("Coro::idle", FALSE), G_DISCARD);
1602	SPAGAIN;
1603
1604	FREETMPS;
1605	LEAVE;
1606	continue;
1607	}
1608
1609	ta->next = SvSTATE (next_sv);
1610
1611	/* cannot transfer to destroyed coros, skip and look for next */
1612	if (expect_false (ta->next->flags & CF_DESTROYED))
1613	{
1614	UNLOCK;
1615	SvREFCNT_dec (next_sv);
1616	/* coro_nready has already been taken care of by destroy */
1617	continue;
1618	}
1619
1620	--coro_nready;
1621	UNLOCK;
1622	break;
1623	}
1624
1625	/* free this only after the transfer */
1626	prev_sv = SvRV (coro_current);	1660	SV *prev_sv = SvRV (coro_current);
		1661
1627	ta->prev = SvSTATE (prev_sv);	1662	ta->prev = SvSTATE_hv (prev_sv);
		1663	ta->next = next;
		1664
1628	TRANSFER_CHECK (*ta);	1665	TRANSFER_CHECK (*ta);
1629	assert (("FATAL: next coroutine isn't marked as ready in Coro (please report)", ta->next->flags & CF_READY));	1666
1630	ta->next->flags &= ~CF_READY;
1631	SvRV_set (coro_current, next_sv);	1667	SvRV_set (coro_current, (SV *)next->hv);
1632		1668
1633	LOCK;
1634	free_coro_mortal (aTHX);	1669	free_coro_mortal (aTHX);
1635	coro_mortal = prev_sv;	1670	coro_mortal = prev_sv;
1636	UNLOCK;	1671	}
		1672
		1673	static void
		1674	prepare_schedule (pTHX_ struct coro_transfer_args *ta)
		1675	{
		1676	for (;;)
		1677	{
		1678	SV *next_sv = coro_deq (aTHX);
		1679
		1680	if (expect_true (next_sv))
		1681	{
		1682	struct coro *next = SvSTATE_hv (next_sv);
		1683
		1684	/* cannot transfer to destroyed coros, skip and look for next */
		1685	if (expect_false (next->flags & CF_DESTROYED))
		1686	SvREFCNT_dec (next_sv); /* coro_nready has already been taken care of by destroy */
		1687	else
		1688	{
		1689	next->flags &= ~CF_READY;
		1690	--coro_nready;
		1691
		1692	prepare_schedule_to (aTHX_ ta, next);
		1693	break;
		1694	}
		1695	}
		1696	else
		1697	{
		1698	/* nothing to schedule: call the idle handler */
		1699	if (SvROK (sv_idle)
		1700	&& SvOBJECT (SvRV (sv_idle)))
		1701	{
		1702	++coro_nready; /* hack so that api_ready doesn't invoke ready hook */
		1703	api_ready (aTHX_ SvRV (sv_idle));
		1704	--coro_nready;
		1705	}
		1706	else
		1707	{
		1708	dSP;
		1709
		1710	ENTER;
		1711	SAVETMPS;
		1712
		1713	PUSHMARK (SP);
		1714	PUTBACK;
		1715	call_sv (sv_idle, G_VOID \| G_DISCARD);
		1716
		1717	FREETMPS;
		1718	LEAVE;
		1719	}
		1720	}
		1721	}
1637	}	1722	}
1638		1723
1639	INLINE void	1724	INLINE void
1640	prepare_cede (pTHX_ struct coro_transfer_args *ta)	1725	prepare_cede (pTHX_ struct coro_transfer_args *ta)
1641	{	1726	{
…		…
1662	{	1747	{
1663	struct coro_transfer_args ta;	1748	struct coro_transfer_args ta;
1664		1749
1665	prepare_schedule (aTHX_ &ta);	1750	prepare_schedule (aTHX_ &ta);
1666	TRANSFER (ta, 1);	1751	TRANSFER (ta, 1);
		1752	}
		1753
		1754	static void
		1755	api_schedule_to (pTHX_ SV *coro_sv)
		1756	{
		1757	struct coro_transfer_args ta;
		1758	struct coro *next = SvSTATE (coro_sv);
		1759
		1760	SvREFCNT_inc_NN (coro_sv);
		1761	prepare_schedule_to (aTHX_ &ta, next);
1667	}	1762	}
1668		1763
1669	static int	1764	static int
1670	api_cede (pTHX)	1765	api_cede (pTHX)
1671	{	1766	{
…		…
1700	static void	1795	static void
1701	api_trace (pTHX_ SV *coro_sv, int flags)	1796	api_trace (pTHX_ SV *coro_sv, int flags)
1702	{	1797	{
1703	struct coro *coro = SvSTATE (coro_sv);	1798	struct coro *coro = SvSTATE (coro_sv);
1704		1799
		1800	if (coro->flags & CF_RUNNING)
		1801	croak ("cannot enable tracing on a running coroutine, caught");
		1802
1705	if (flags & CC_TRACE)	1803	if (flags & CC_TRACE)
1706	{	1804	{
1707	if (!coro->cctx)	1805	if (!coro->cctx)
1708	coro->cctx = cctx_new_run ();	1806	coro->cctx = cctx_new_run ();
1709	else if (!(coro->cctx->flags & CC_TRACE))	1807	else if (!(coro->cctx->flags & CC_TRACE))
1710	croak ("cannot enable tracing on coroutine with custom stack,");	1808	croak ("cannot enable tracing on coroutine with custom stack, caught");
1711		1809
1712	coro->cctx->flags \|= CC_NOREUSE \| (flags & (CC_TRACE \| CC_TRACE_ALL));	1810	coro->cctx->flags \|= CC_NOREUSE \| (flags & (CC_TRACE \| CC_TRACE_ALL));
1713	}	1811	}
1714	else if (coro->cctx && coro->cctx->flags & CC_TRACE)	1812	else if (coro->cctx && coro->cctx->flags & CC_TRACE)
1715	{	1813	{
…		…
1720	else	1818	else
1721	coro->slot->runops = RUNOPS_DEFAULT;	1819	coro->slot->runops = RUNOPS_DEFAULT;
1722	}	1820	}
1723	}	1821	}
1724		1822
1725	#if 0	1823	static void
		1824	coro_call_on_destroy (pTHX_ struct coro *coro)
		1825	{
		1826	SV **on_destroyp = hv_fetch (coro->hv, "_on_destroy", sizeof ("_on_destroy") - 1, 0);
		1827	SV **statusp = hv_fetch (coro->hv, "_status", sizeof ("_status") - 1, 0);
		1828
		1829	if (on_destroyp)
		1830	{
		1831	AV on_destroy = (AV )SvRV (*on_destroyp);
		1832
		1833	while (AvFILLp (on_destroy) >= 0)
		1834	{
		1835	dSP; /* don't disturb outer sp */
		1836	SV *cb = av_pop (on_destroy);
		1837
		1838	PUSHMARK (SP);
		1839
		1840	if (statusp)
		1841	{
		1842	int i;
		1843	AV status = (AV )SvRV (*statusp);
		1844	EXTEND (SP, AvFILLp (status) + 1);
		1845
		1846	for (i = 0; i <= AvFILLp (status); ++i)
		1847	PUSHs (AvARRAY (status)[i]);
		1848	}
		1849
		1850	PUTBACK;
		1851	call_sv (sv_2mortal (cb), G_VOID \| G_DISCARD);
		1852	}
		1853	}
		1854	}
		1855
		1856	static void
		1857	slf_init_terminate (pTHX_ struct CoroSLF frame, CV cv, SV **arg, int items)
		1858	{
		1859	int i;
		1860	HV hv = (HV )SvRV (coro_current);
		1861	AV *av = newAV ();
		1862
		1863	av_extend (av, items - 1);
		1864	for (i = 0; i < items; ++i)
		1865	av_push (av, SvREFCNT_inc_NN (arg [i]));
		1866
		1867	hv_store (hv, "_status", sizeof ("_status") - 1, newRV_noinc ((SV *)av), 0);
		1868
		1869	av_push (av_destroy, (SV )newRV_inc ((SV )hv)); /* RVinc for perl */
		1870	api_ready (aTHX_ sv_manager);
		1871
		1872	frame->prepare = prepare_schedule;
		1873	frame->check = slf_check_repeat;
		1874
		1875	/* as a minor optimisation, we could unwind all stacks here */
		1876	/* but that puts extra pressure on pp_slf, and is not worth much */
		1877	/coro_unwind_stacks (aTHX);/
		1878	}
		1879
		1880	/*****************************************************************************/
		1881	/* async pool handler */
		1882
1726	static int	1883	static int
1727	coro_gensub_free (pTHX_ SV sv, MAGIC mg)	1884	slf_check_pool_handler (pTHX_ struct CoroSLF *frame)
1728	{	1885	{
1729	AV *padlist;	1886	HV hv = (HV )SvRV (coro_current);
1730	AV av = (AV )mg->mg_obj;	1887	struct coro coro = (struct coro )frame->data;
1731		1888
1732	abort ();	1889	if (!coro->invoke_cb)
		1890	return 1; /* loop till we have invoke */
		1891	else
		1892	{
		1893	hv_store (hv, "desc", sizeof ("desc") - 1,
		1894	newSVpvn ("[async_pool]", sizeof ("[async_pool]") - 1), 0);
		1895
		1896	coro->saved_deffh = SvREFCNT_inc_NN ((SV *)PL_defoutgv);
		1897
		1898	{
		1899	dSP;
		1900	XPUSHs (sv_2mortal (coro->invoke_cb)); coro->invoke_cb = 0;
		1901	PUTBACK;
		1902	}
		1903
		1904	SvREFCNT_dec (GvAV (PL_defgv));
		1905	GvAV (PL_defgv) = coro->invoke_av;
		1906	coro->invoke_av = 0;
		1907
		1908	return 0;
		1909	}
		1910	}
		1911
		1912	static void
		1913	slf_init_pool_handler (pTHX_ struct CoroSLF frame, CV cv, SV **arg, int items)
		1914	{
		1915	HV hv = (HV )SvRV (coro_current);
		1916	struct coro coro = SvSTATE_hv ((SV )hv);
		1917
		1918	if (expect_true (coro->saved_deffh))
		1919	{
		1920	/* subsequent iteration */
		1921	SvREFCNT_dec ((SV )PL_defoutgv); PL_defoutgv = (GV )coro->saved_deffh;
		1922	coro->saved_deffh = 0;
		1923
		1924	if (coro_rss (aTHX_ coro) > SvUV (sv_pool_rss)
		1925	\|\| av_len (av_async_pool) + 1 >= SvIV (sv_pool_size))
		1926	{
		1927	coro->invoke_cb = SvREFCNT_inc_NN ((SV *)cv_coro_terminate);
		1928	coro->invoke_av = newAV ();
		1929
		1930	frame->prepare = prepare_nop;
		1931	}
		1932	else
		1933	{
		1934	av_clear (GvAV (PL_defgv));
		1935	hv_store (hv, "desc", sizeof ("desc") - 1, SvREFCNT_inc_NN (sv_async_pool_idle), 0);
		1936
		1937	coro->prio = 0;
		1938
		1939	if (coro->cctx && (coro->cctx->flags & CC_TRACE))
		1940	api_trace (aTHX_ coro_current, 0);
		1941
		1942	frame->prepare = prepare_schedule;
		1943	av_push (av_async_pool, SvREFCNT_inc (hv));
		1944	}
		1945	}
		1946	else
		1947	{
		1948	/* first iteration, simply fall through */
		1949	frame->prepare = prepare_nop;
		1950	}
		1951
		1952	frame->check = slf_check_pool_handler;
		1953	frame->data = (void *)coro;
		1954	}
		1955
		1956	/*****************************************************************************/
		1957	/* rouse callback */
		1958
		1959	#define CORO_MAGIC_type_rouse PERL_MAGIC_ext
		1960
		1961	static void
		1962	coro_rouse_callback (pTHX_ CV *cv)
		1963	{
		1964	dXSARGS;
		1965	SV data = (SV )GENSUB_ARG;
		1966
		1967	if (SvTYPE (SvRV (data)) != SVt_PVAV)
		1968	{
		1969	/* first call, set args */
		1970	AV *av = newAV ();
		1971	SV *coro = SvRV (data);
		1972
		1973	SvRV_set (data, (SV *)av);
		1974	api_ready (aTHX_ coro);
		1975	SvREFCNT_dec (coro);
		1976
		1977	/* better take a full copy of the arguments */
		1978	while (items--)
		1979	av_store (av, items, newSVsv (ST (items)));
		1980	}
		1981
		1982	XSRETURN_EMPTY;
		1983	}
		1984
		1985	static int
		1986	slf_check_rouse_wait (pTHX_ struct CoroSLF *frame)
		1987	{
		1988	SV data = (SV )frame->data;
		1989
		1990	if (CORO_THROW)
		1991	return 0;
		1992
		1993	if (SvTYPE (SvRV (data)) != SVt_PVAV)
		1994	return 1;
		1995
		1996	/* now push all results on the stack */
		1997	{
		1998	dSP;
		1999	AV av = (AV )SvRV (data);
		2000	int i;
		2001
		2002	EXTEND (SP, AvFILLp (av) + 1);
		2003	for (i = 0; i <= AvFILLp (av); ++i)
		2004	PUSHs (sv_2mortal (AvARRAY (av)[i]));
		2005
		2006	/* we have stolen the elements, so ste length to zero and free */
		2007	AvFILLp (av) = -1;
		2008	av_undef (av);
		2009
		2010	PUTBACK;
		2011	}
1733		2012
1734	return 0;	2013	return 0;
1735	}	2014	}
1736		2015
1737	static MGVTBL coro_gensub_vtbl = {	2016	static void
1738	0, 0, 0, 0,	2017	slf_init_rouse_wait (pTHX_ struct CoroSLF frame, CV cv, SV **arg, int items)
1739	coro_gensub_free	2018	{
1740	};	2019	SV *cb;
1741	#endif	2020
		2021	if (items)
		2022	cb = arg [0];
		2023	else
		2024	{
		2025	struct coro *coro = SvSTATE_current;
		2026
		2027	if (!coro->rouse_cb)
		2028	croak ("Coro::rouse_wait called without rouse callback, and no default rouse callback found either,");
		2029
		2030	cb = sv_2mortal (coro->rouse_cb);
		2031	coro->rouse_cb = 0;
		2032	}
		2033
		2034	if (!SvROK (cb)
		2035	\|\| SvTYPE (SvRV (cb)) != SVt_PVCV
		2036	\|\| CvXSUB ((CV *)SvRV (cb)) != coro_rouse_callback)
		2037	croak ("Coro::rouse_wait called with illegal callback argument,");
		2038
		2039	{
		2040	CV cv = (CV )SvRV (cb); /* for GENSUB_ARG */
		2041	SV data = (SV )GENSUB_ARG;
		2042
		2043	frame->data = (void *)data;
		2044	frame->prepare = SvTYPE (SvRV (data)) == SVt_PVAV ? prepare_nop : prepare_schedule;
		2045	frame->check = slf_check_rouse_wait;
		2046	}
		2047	}
		2048
		2049	static SV *
		2050	coro_new_rouse_cb (pTHX)
		2051	{
		2052	HV hv = (HV )SvRV (coro_current);
		2053	struct coro *coro = SvSTATE_hv (hv);
		2054	SV data = newRV_inc ((SV )hv);
		2055	SV cb = gensub (aTHX_ coro_rouse_callback, (void )data);
		2056
		2057	sv_magicext (SvRV (cb), data, CORO_MAGIC_type_rouse, 0, 0, 0);
		2058	SvREFCNT_dec (data); /* magicext increases the refcount */
		2059
		2060	SvREFCNT_dec (coro->rouse_cb);
		2061	coro->rouse_cb = SvREFCNT_inc_NN (cb);
		2062
		2063	return cb;
		2064	}
		2065
		2066	/*****************************************************************************/
		2067	/* schedule-like-function opcode (SLF) */
		2068
		2069	static UNOP slf_restore; /* restore stack as entersub did, for first-re-run */
		2070	static const CV *slf_cv;
		2071	static SV **slf_argv;
		2072	static int slf_argc, slf_arga; /* count, allocated */
		2073	static I32 slf_ax; /* top of stack, for restore */
		2074
		2075	/* this restores the stack in the case we patched the entersub, to */
		2076	/* recreate the stack frame as perl will on following calls */
		2077	/* since entersub cleared the stack */
		2078	static OP *
		2079	pp_restore (pTHX)
		2080	{
		2081	int i;
		2082	SV **SP = PL_stack_base + slf_ax;
		2083
		2084	PUSHMARK (SP);
		2085
		2086	EXTEND (SP, slf_argc + 1);
		2087
		2088	for (i = 0; i < slf_argc; ++i)
		2089	PUSHs (sv_2mortal (slf_argv [i]));
		2090
		2091	PUSHs ((SV *)CvGV (slf_cv));
		2092
		2093	RETURNOP (slf_restore.op_first);
		2094	}
		2095
		2096	static void
		2097	slf_prepare_transfer (pTHX_ struct coro_transfer_args *ta)
		2098	{
		2099	SV arg = (SV )slf_frame.data;
		2100
		2101	prepare_transfer (aTHX_ ta, arg [0], arg [1]);
		2102	}
		2103
		2104	static void
		2105	slf_init_transfer (pTHX_ struct CoroSLF frame, CV cv, SV **arg, int items)
		2106	{
		2107	if (items != 2)
		2108	croak ("Coro::State::transfer (prev, next) expects two arguments, not %d,", items);
		2109
		2110	frame->prepare = slf_prepare_transfer;
		2111	frame->check = slf_check_nop;
		2112	frame->data = (void )arg; / let's hope it will stay valid */
		2113	}
		2114
		2115	static void
		2116	slf_init_schedule (pTHX_ struct CoroSLF frame, CV cv, SV **arg, int items)
		2117	{
		2118	frame->prepare = prepare_schedule;
		2119	frame->check = slf_check_nop;
		2120	}
		2121
		2122	static void
		2123	slf_prepare_schedule_to (pTHX_ struct coro_transfer_args *ta)
		2124	{
		2125	struct coro next = (struct coro )slf_frame.data;
		2126
		2127	SvREFCNT_inc_NN (next->hv);
		2128	prepare_schedule_to (aTHX_ ta, next);
		2129	}
		2130
		2131	static void
		2132	slf_init_schedule_to (pTHX_ struct CoroSLF frame, CV cv, SV **arg, int items)
		2133	{
		2134	if (!items)
		2135	croak ("Coro::schedule_to expects a coroutine argument, caught");
		2136
		2137	frame->data = (void *)SvSTATE (arg [0]);
		2138	frame->prepare = slf_prepare_schedule_to;
		2139	frame->check = slf_check_nop;
		2140	}
		2141
		2142	static void
		2143	slf_init_cede_to (pTHX_ struct CoroSLF frame, CV cv, SV **arg, int items)
		2144	{
		2145	api_ready (aTHX_ SvRV (coro_current));
		2146
		2147	slf_init_schedule_to (aTHX_ frame, cv, arg, items);
		2148	}
		2149
		2150	static void
		2151	slf_init_cede (pTHX_ struct CoroSLF frame, CV cv, SV **arg, int items)
		2152	{
		2153	frame->prepare = prepare_cede;
		2154	frame->check = slf_check_nop;
		2155	}
		2156
		2157	static void
		2158	slf_init_cede_notself (pTHX_ struct CoroSLF frame, CV cv, SV **arg, int items)
		2159	{
		2160	frame->prepare = prepare_cede_notself;
		2161	frame->check = slf_check_nop;
		2162	}
		2163
		2164	/*
		2165	* these not obviously related functions are all rolled into one
		2166	* function to increase chances that they all will call transfer with the same
		2167	* stack offset
		2168	* SLF stands for "schedule-like-function".
		2169	*/
		2170	static OP *
		2171	pp_slf (pTHX)
		2172	{
		2173	I32 checkmark; /* mark SP to see how many elements check has pushed */
		2174
		2175	/* set up the slf frame, unless it has already been set-up */
		2176	/* the latter happens when a new coro has been started */
		2177	/* or when a new cctx was attached to an existing coroutine */
		2178	if (expect_true (!slf_frame.prepare))
		2179	{
		2180	/* first iteration */
		2181	dSP;
		2182	SV **arg = PL_stack_base + TOPMARK + 1;
		2183	int items = SP - arg; /* args without function object */
		2184	SV gv = sp;
		2185
		2186	/* do a quick consistency check on the "function" object, and if it isn't */
		2187	/* for us, divert to the real entersub */
		2188	if (SvTYPE (gv) != SVt_PVGV
		2189	\|\| !GvCV (gv)
		2190	\|\| !(CvFLAGS (GvCV (gv)) & CVf_SLF))
		2191	return PL_ppaddr[OP_ENTERSUB](aTHX);
		2192
		2193	if (!(PL_op->op_flags & OPf_STACKED))
		2194	{
		2195	/* ampersand-form of call, use @_ instead of stack */
		2196	AV *av = GvAV (PL_defgv);
		2197	arg = AvARRAY (av);
		2198	items = AvFILLp (av) + 1;
		2199	}
		2200
		2201	/* now call the init function, which needs to set up slf_frame */
		2202	((coro_slf_cb)CvXSUBANY (GvCV (gv)).any_ptr)
		2203	(aTHX_ &slf_frame, GvCV (gv), arg, items);
		2204
		2205	/* pop args */
		2206	SP = PL_stack_base + POPMARK;
		2207
		2208	PUTBACK;
		2209	}
		2210
		2211	/* now that we have a slf_frame, interpret it! */
		2212	/* we use a callback system not to make the code needlessly */
		2213	/* complicated, but so we can run multiple perl coros from one cctx */
		2214
		2215	do
		2216	{
		2217	struct coro_transfer_args ta;
		2218
		2219	slf_frame.prepare (aTHX_ &ta);
		2220	TRANSFER (ta, 0);
		2221
		2222	checkmark = PL_stack_sp - PL_stack_base;
		2223	}
		2224	while (slf_frame.check (aTHX_ &slf_frame));
		2225
		2226	slf_frame.prepare = 0; /* invalidate the frame, we are done processing it */
		2227
		2228	/* exception handling */
		2229	if (expect_false (CORO_THROW))
		2230	{
		2231	SV *exception = sv_2mortal (CORO_THROW);
		2232
		2233	CORO_THROW = 0;
		2234	sv_setsv (ERRSV, exception);
		2235	croak (0);
		2236	}
		2237
		2238	/* return value handling - mostly like entersub */
		2239	/* make sure we put something on the stack in scalar context */
		2240	if (GIMME_V == G_SCALAR)
		2241	{
		2242	dSP;
		2243	SV **bot = PL_stack_base + checkmark;
		2244
		2245	if (sp == bot) /* too few, push undef */
		2246	bot [1] = &PL_sv_undef;
		2247	else if (sp != bot + 1) /* too many, take last one */
		2248	bot [1] = *sp;
		2249
		2250	SP = bot + 1;
		2251
		2252	PUTBACK;
		2253	}
		2254
		2255	return NORMAL;
		2256	}
		2257
		2258	static void
		2259	api_execute_slf (pTHX_ CV *cv, coro_slf_cb init_cb, I32 ax)
		2260	{
		2261	int i;
		2262	SV **arg = PL_stack_base + ax;
		2263	int items = PL_stack_sp - arg + 1;
		2264
		2265	assert (("FATAL: SLF call with illegal CV value", !CvANON (cv)));
		2266
		2267	if (PL_op->op_ppaddr != PL_ppaddr [OP_ENTERSUB]
		2268	&& PL_op->op_ppaddr != pp_slf)
		2269	croak ("FATAL: Coro SLF calls can only be made normally, not via goto or any other means, caught");
		2270
		2271	CvFLAGS (cv) \|= CVf_SLF;
		2272	CvXSUBANY (cv).any_ptr = (void *)init_cb;
		2273	slf_cv = cv;
		2274
		2275	/* we patch the op, and then re-run the whole call */
		2276	/* we have to put the same argument on the stack for this to work */
		2277	/* and this will be done by pp_restore */
		2278	slf_restore.op_next = (OP *)&slf_restore;
		2279	slf_restore.op_type = OP_CUSTOM;
		2280	slf_restore.op_ppaddr = pp_restore;
		2281	slf_restore.op_first = PL_op;
		2282
		2283	slf_ax = ax - 1; /* undo the ax++ inside dAXMARK */
		2284
		2285	if (PL_op->op_flags & OPf_STACKED)
		2286	{
		2287	if (items > slf_arga)
		2288	{
		2289	slf_arga = items;
		2290	free (slf_argv);
		2291	slf_argv = malloc (slf_arga * sizeof (SV *));
		2292	}
		2293
		2294	slf_argc = items;
		2295
		2296	for (i = 0; i < items; ++i)
		2297	slf_argv [i] = SvREFCNT_inc (arg [i]);
		2298	}
		2299	else
		2300	slf_argc = 0;
		2301
		2302	PL_op->op_ppaddr = pp_slf;
		2303	/PL_op->op_type = OP_CUSTOM; / we do behave like entersub still */
		2304
		2305	PL_op = (OP *)&slf_restore;
		2306	}
1742		2307
1743	/*****************************************************************************/	2308	/*****************************************************************************/
1744	/* PerlIO::cede */	2309	/* PerlIO::cede */
1745		2310
1746	typedef struct	2311	typedef struct
…		…
1814	PerlIOBuf_get_cnt,	2379	PerlIOBuf_get_cnt,
1815	PerlIOBuf_set_ptrcnt,	2380	PerlIOBuf_set_ptrcnt,
1816	};	2381	};
1817		2382
1818	/*****************************************************************************/	2383	/*****************************************************************************/
		2384	/* Coro::Semaphore & Coro::Signal */
1819		2385
1820	static const CV slf_cv; / for quick consistency check */
1821
1822	static UNOP slf_restore; /* restore stack as entersub did, for first-re-run */
1823	static SV *slf_arg0;
1824	static SV *slf_arg1;
1825	static SV *slf_arg2;
1826
1827	/* this restores the stack in the case we patched the entersub, to */
1828	/* recreate the stack frame as perl will on following calls */
1829	/* since entersub cleared the stack */
1830	static OP *	2386	static SV *
1831	pp_restore (pTHX)	2387	coro_waitarray_new (pTHX_ int count)
1832	{	2388	{
1833	dSP;	2389	/* a semaphore contains a counter IV in $sem->[0] and any waiters after that */
		2390	AV *av = newAV ();
		2391	SV **ary;
1834		2392
1835	PUSHMARK (SP);	2393	/* unfortunately, building manually saves memory */
		2394	Newx (ary, 2, SV *);
		2395	AvALLOC (av) = ary;
		2396	#if PERL_VERSION_ATLEAST (5,10,0)
		2397	AvARRAY (av) = ary;
		2398	#else
		2399	/* 5.8.8 needs this syntax instead of AvARRAY = ary, yet */
		2400	/* -DDEBUGGING flags this as a bug, despite it perfectly working */
		2401	SvPVX ((SV )av) = (char )ary;
		2402	#endif
		2403	AvMAX (av) = 1;
		2404	AvFILLp (av) = 0;
		2405	ary [0] = newSViv (count);
1836		2406
1837	EXTEND (SP, 3);	2407	return newRV_noinc ((SV *)av);
1838	if (slf_arg0) PUSHs (sv_2mortal (slf_arg0));
1839	if (slf_arg1) PUSHs (sv_2mortal (slf_arg1));
1840	if (slf_arg2) PUSHs (sv_2mortal (slf_arg2));
1841	PUSHs ((SV *)CvGV (slf_cv));
1842
1843	RETURNOP (slf_restore.op_first);
1844	}	2408	}
1845		2409
1846	static void	2410	/* semaphore */
1847	slf_prepare_set_stacklevel (pTHX_ struct coro_transfer_args *ta)
1848	{
1849	prepare_set_stacklevel (ta, (struct coro_cctx *)slf_frame.data);
1850	}
1851		2411
1852	static void	2412	static void
1853	slf_init_set_stacklevel (pTHX_ struct CoroSLF frame, SV *arg, int items)	2413	coro_semaphore_adjust (pTHX_ AV *av, IV adjust)
1854	{	2414	{
1855	assert (("FATAL: set_stacklevel needs the coro cctx as sole argument", items == 1));	2415	SV *count_sv = AvARRAY (av)[0];
		2416	IV count = SvIVX (count_sv);
1856		2417
1857	frame->prepare = slf_prepare_set_stacklevel;	2418	count += adjust;
1858	frame->check = slf_check_nop;	2419	SvIVX (count_sv) = count;
1859	frame->data = (void *)SvIV (arg [0]);
1860	}
1861		2420
1862	static void	2421	/* now wake up as many waiters as are expected to lock */
1863	slf_prepare_transfer (pTHX_ struct coro_transfer_args *ta)	2422	while (count > 0 && AvFILLp (av) > 0)
1864	{
1865	SV arg = (SV )slf_frame.data;
1866
1867	prepare_transfer (aTHX_ ta, arg [0], arg [1]);
1868	}
1869
1870	static void
1871	slf_init_transfer (pTHX_ struct CoroSLF frame, SV *arg, int items)
1872	{
1873	if (items != 2)
1874	croak ("Coro::State::transfer (prev, next) expects two arguments, not %d,", items);
1875
1876	frame->prepare = slf_prepare_transfer;
1877	frame->check = slf_check_nop;
1878	frame->data = (void )arg; / let's hope it will stay valid */
1879	}
1880
1881	static void
1882	slf_init_schedule (pTHX_ struct CoroSLF frame, SV *arg, int items)
1883	{
1884	frame->prepare = prepare_schedule;
1885	frame->check = slf_check_nop;
1886	}
1887
1888	static void
1889	slf_init_cede (pTHX_ struct CoroSLF frame, SV *arg, int items)
1890	{
1891	frame->prepare = prepare_cede;
1892	frame->check = slf_check_nop;
1893	}
1894
1895	static void
1896	slf_init_cede_notself (pTHX_ struct CoroSLF frame, SV *arg, int items)
1897	{
1898	frame->prepare = prepare_cede_notself;
1899	frame->check = slf_check_nop;
1900	}
1901
1902	/* we hijack an hopefully unused CV flag for our purposes */
1903	#define CVf_SLF 0x4000
1904
1905	/*
1906	* these not obviously related functions are all rolled into one
1907	* function to increase chances that they all will call transfer with the same
1908	* stack offset
1909	* SLF stands for "schedule-like-function".
1910	*/
1911	static OP *
1912	pp_slf (pTHX)
1913	{
1914	I32 checkmark; /* mark SP to see how many elements check has pushed */
1915
1916	/* set up the slf frame, unless it has already been set-up */
1917	/* the latter happens when a new coro has been started */
1918	/* or when a new cctx was attached to an existing coroutine */
1919	if (expect_true (!slf_frame.prepare))
1920	{	2423	{
1921	/* first iteration */	2424	SV *cb;
1922	dSP;
1923	SV **arg = PL_stack_base + TOPMARK + 1;
1924	int items = SP - arg; /* args without function object */
1925	SV gv = sp;
1926		2425
1927	/* do a quick consistency check on the "function" object, and if it isn't */	2426	/* swap first two elements so we can shift a waiter */
1928	/* for us, divert to the real entersub */	2427	AvARRAY (av)[0] = AvARRAY (av)[1];
1929	if (SvTYPE (gv) != SVt_PVGV \|\| !(CvFLAGS (GvCV (gv)) & CVf_SLF))	2428	AvARRAY (av)[1] = count_sv;
1930	return PL_ppaddr[OP_ENTERSUB](aTHX);	2429	cb = av_shift (av);
1931		2430
1932	/* pop args */	2431	if (SvOBJECT (cb))
1933	SP = PL_stack_base + POPMARK;
1934
1935	if (!(PL_op->op_flags & OPf_STACKED))
1936	{	2432	{
1937	/* ampersand-form of call, use @_ instead of stack */	2433	api_ready (aTHX_ cb);
1938	AV *av = GvAV (PL_defgv);	2434	--count;
1939	arg = AvARRAY (av);
1940	items = AvFILLp (av) + 1;
1941	}	2435	}
1942		2436	else if (SvTYPE (cb) == SVt_PVCV)
1943	PUTBACK;
1944
1945	((coro_slf_cb)CvXSUBANY (GvCV (gv)).any_ptr) (aTHX_ &slf_frame, arg, items);
1946	}
1947
1948	/* now interpret the slf_frame */
1949	/* we use a callback system not to make the code needlessly */
1950	/* complicated, but so we can run multiple perl coros from one cctx */
1951
1952	do
1953	{
1954	struct coro_transfer_args ta;
1955
1956	slf_frame.prepare (aTHX_ &ta);
1957	TRANSFER (ta, 0);
1958
1959	checkmark = PL_stack_sp - PL_stack_base;
1960	}
1961	while (slf_frame.check (aTHX_ &slf_frame));
1962
1963	{
1964	dSP;
1965	SV **bot = PL_stack_base + checkmark;
1966	int gimme = GIMME_V;
1967
1968	slf_frame.prepare = 0; /* signal pp_slf that we need a new frame */
1969
1970	/* make sure we put something on the stack in scalar context */
1971	if (gimme == G_SCALAR)
1972	{	2437	{
1973	if (sp == bot)	2438	dSP;
1974	XPUSHs (&PL_sv_undef);	2439	PUSHMARK (SP);
1975		2440	XPUSHs (sv_2mortal (newRV_inc ((SV *)av)));
1976	SP = bot + 1;	2441	PUTBACK;
		2442	call_sv (cb, G_VOID \| G_DISCARD \| G_EVAL \| G_KEEPERR);
1977	}	2443	}
1978		2444
1979	PUTBACK;	2445	SvREFCNT_dec (cb);
1980	}	2446	}
1981
1982	return NORMAL;
1983	}	2447	}
1984		2448
1985	static void	2449	static void
1986	api_execute_slf (pTHX_ CV cv, coro_slf_cb init_cb, SV *arg, int items)	2450	coro_semaphore_on_destroy (pTHX_ struct coro *coro)
1987	{	2451	{
1988	assert (("FATAL: SLF call with illegal CV value", !CvANON (cv)));	2452	/* call $sem->adjust (0) to possibly wake up some other waiters */
1989		2453	coro_semaphore_adjust (aTHX_ (AV *)coro->slf_frame.data, 0);
1990	if (PL_op->op_ppaddr != PL_ppaddr [OP_ENTERSUB]
1991	&& PL_op->op_ppaddr != pp_slf)
1992	croak ("FATAL: Coro SLF calls can only be made normally, not via goto or any other means, caught");
1993
1994	if (items > 3)
1995	croak ("Coro only supports up to three arguments to SLF functions currently (not %d), caught", items);
1996
1997	CvFLAGS (cv) \|= CVf_SLF;
1998	CvXSUBANY (cv).any_ptr = (void *)init_cb;
1999	slf_cv = cv;
2000
2001	/* we patch the op, and then re-run the whole call */
2002	/* we have to put the same argument on the stack for this to work */
2003	/* and this will be done by pp_restore */
2004	slf_restore.op_next = (OP *)&slf_restore;
2005	slf_restore.op_type = OP_NULL;
2006	slf_restore.op_ppaddr = pp_restore;
2007	slf_restore.op_first = PL_op;
2008
2009	slf_arg0 = items > 0 ? SvREFCNT_inc (arg [0]) : 0;
2010	slf_arg1 = items > 1 ? SvREFCNT_inc (arg [1]) : 0;
2011	slf_arg2 = items > 2 ? SvREFCNT_inc (arg [2]) : 0;
2012
2013	PL_op->op_ppaddr = pp_slf;
2014
2015	PL_op = (OP *)&slf_restore;
2016	}	2454	}
2017
2018	/*****************************************************************************/
2019		2455
2020	static int	2456	static int
2021	slf_check_semaphore_down (pTHX_ struct CoroSLF *frame)	2457	slf_check_semaphore_down_or_wait (pTHX_ struct CoroSLF *frame, int acquire)
2022	{	2458	{
2023	AV av = (AV )frame->data;	2459	AV av = (AV )frame->data;
2024	SV *count_sv = AvARRAY (av)[0];	2460	SV *count_sv = AvARRAY (av)[0];
2025		2461
		2462	/* if we are about to throw, don't actually acquire the lock, just throw */
		2463	if (CORO_THROW)
		2464	return 0;
2026	if (SvIVX (count_sv) > 0)	2465	else if (SvIVX (count_sv) > 0)
2027	{	2466	{
		2467	SvSTATE_current->on_destroy = 0;
		2468
		2469	if (acquire)
2028	SvIVX (count_sv) = SvIVX (count_sv) - 1;	2470	SvIVX (count_sv) = SvIVX (count_sv) - 1;
		2471	else
		2472	coro_semaphore_adjust (aTHX_ av, 0);
		2473
2029	return 0;	2474	return 0;
2030	}	2475	}
2031	else	2476	else
2032	{	2477	{
2033	int i;	2478	int i;
…		…
2042	av_push (av, SvREFCNT_inc (SvRV (coro_current)));	2487	av_push (av, SvREFCNT_inc (SvRV (coro_current)));
2043	return 1;	2488	return 1;
2044	}	2489	}
2045	}	2490	}
2046		2491
2047	static void	2492	static int
		2493	slf_check_semaphore_down (pTHX_ struct CoroSLF *frame)
		2494	{
		2495	return slf_check_semaphore_down_or_wait (aTHX_ frame, 1);
		2496	}
		2497
		2498	static int
		2499	slf_check_semaphore_wait (pTHX_ struct CoroSLF *frame)
		2500	{
		2501	return slf_check_semaphore_down_or_wait (aTHX_ frame, 0);
		2502	}
		2503
		2504	static void
2048	slf_init_semaphore_down (pTHX_ struct CoroSLF frame, SV *arg, int items)	2505	slf_init_semaphore_down_or_wait (pTHX_ struct CoroSLF frame, CV cv, SV **arg, int items)
2049	{	2506	{
2050	AV av = (AV )SvRV (arg [0]);	2507	AV av = (AV )SvRV (arg [0]);
2051		2508
2052	if (SvIVX (AvARRAY (av)[0]) > 0)	2509	if (SvIVX (AvARRAY (av)[0]) > 0)
2053	{	2510	{
…		…
2058	{	2515	{
2059	av_push (av, SvREFCNT_inc (SvRV (coro_current)));	2516	av_push (av, SvREFCNT_inc (SvRV (coro_current)));
2060		2517
2061	frame->data = (void )sv_2mortal (SvREFCNT_inc ((SV )av));	2518	frame->data = (void )sv_2mortal (SvREFCNT_inc ((SV )av));
2062	frame->prepare = prepare_schedule;	2519	frame->prepare = prepare_schedule;
2063	}
2064		2520
		2521	/* to avoid race conditions when a woken-up coro gets terminated */
		2522	/* we arrange for a temporary on_destroy that calls adjust (0) */
		2523	SvSTATE_current->on_destroy = coro_semaphore_on_destroy;
		2524	}
		2525	}
		2526
		2527	static void
		2528	slf_init_semaphore_down (pTHX_ struct CoroSLF frame, CV cv, SV **arg, int items)
		2529	{
		2530	slf_init_semaphore_down_or_wait (aTHX_ frame, cv, arg, items);
2065	frame->check = slf_check_semaphore_down;	2531	frame->check = slf_check_semaphore_down;
2066
2067	}	2532	}
		2533
		2534	static void
		2535	slf_init_semaphore_wait (pTHX_ struct CoroSLF frame, CV cv, SV **arg, int items)
		2536	{
		2537	if (items >= 2)
		2538	{
		2539	/* callback form */
		2540	AV av = (AV )SvRV (arg [0]);
		2541	CV *cb_cv = coro_sv_2cv (aTHX_ arg [1]);
		2542
		2543	av_push (av, (SV *)SvREFCNT_inc_NN (cb_cv));
		2544
		2545	if (SvIVX (AvARRAY (av)[0]) > 0)
		2546	coro_semaphore_adjust (aTHX_ av, 0);
		2547
		2548	frame->prepare = prepare_nop;
		2549	frame->check = slf_check_nop;
		2550	}
		2551	else
		2552	{
		2553	slf_init_semaphore_down_or_wait (aTHX_ frame, cv, arg, items);
		2554	frame->check = slf_check_semaphore_wait;
		2555	}
		2556	}
		2557
		2558	/* signal */
		2559
		2560	static void
		2561	coro_signal_wake (pTHX_ AV *av, int count)
		2562	{
		2563	SvIVX (AvARRAY (av)[0]) = 0;
		2564
		2565	/* now signal count waiters */
		2566	while (count > 0 && AvFILLp (av) > 0)
		2567	{
		2568	SV *cb;
		2569
		2570	/* swap first two elements so we can shift a waiter */
		2571	cb = AvARRAY (av)[0];
		2572	AvARRAY (av)[0] = AvARRAY (av)[1];
		2573	AvARRAY (av)[1] = cb;
		2574
		2575	cb = av_shift (av);
		2576
		2577	api_ready (aTHX_ cb);
		2578	sv_setiv (cb, 0); /* signal waiter */
		2579	SvREFCNT_dec (cb);
		2580
		2581	--count;
		2582	}
		2583	}
		2584
		2585	static int
		2586	slf_check_signal_wait (pTHX_ struct CoroSLF *frame)
		2587	{
		2588	/* if we are about to throw, also stop waiting */
		2589	return SvROK ((SV *)frame->data) && !CORO_THROW;
		2590	}
		2591
		2592	static void
		2593	slf_init_signal_wait (pTHX_ struct CoroSLF frame, CV cv, SV **arg, int items)
		2594	{
		2595	AV av = (AV )SvRV (arg [0]);
		2596
		2597	if (SvIVX (AvARRAY (av)[0]))
		2598	{
		2599	SvIVX (AvARRAY (av)[0]) = 0;
		2600	frame->prepare = prepare_nop;
		2601	frame->check = slf_check_nop;
		2602	}
		2603	else
		2604	{
		2605	SV waiter = newRV_inc (SvRV (coro_current)); / owned by signal av */
		2606
		2607	av_push (av, waiter);
		2608
		2609	frame->data = (void )sv_2mortal (SvREFCNT_inc_NN (waiter)); / owned by process */
		2610	frame->prepare = prepare_schedule;
		2611	frame->check = slf_check_signal_wait;
		2612	}
		2613	}
		2614
		2615	/*****************************************************************************/
		2616	/* Coro::AIO */
		2617
		2618	#define CORO_MAGIC_type_aio PERL_MAGIC_ext
		2619
		2620	/* helper storage struct */
		2621	struct io_state
		2622	{
		2623	int errorno;
		2624	I32 laststype; /* U16 in 5.10.0 */
		2625	int laststatval;
		2626	Stat_t statcache;
		2627	};
		2628
		2629	static void
		2630	coro_aio_callback (pTHX_ CV *cv)
		2631	{
		2632	dXSARGS;
		2633	AV state = (AV )GENSUB_ARG;
		2634	SV *coro = av_pop (state);
		2635	SV *data_sv = newSV (sizeof (struct io_state));
		2636
		2637	av_extend (state, items - 1);
		2638
		2639	sv_upgrade (data_sv, SVt_PV);
		2640	SvCUR_set (data_sv, sizeof (struct io_state));
		2641	SvPOK_only (data_sv);
		2642
		2643	{
		2644	struct io_state data = (struct io_state )SvPVX (data_sv);
		2645
		2646	data->errorno = errno;
		2647	data->laststype = PL_laststype;
		2648	data->laststatval = PL_laststatval;
		2649	data->statcache = PL_statcache;
		2650	}
		2651
		2652	/* now build the result vector out of all the parameters and the data_sv */
		2653	{
		2654	int i;
		2655
		2656	for (i = 0; i < items; ++i)
		2657	av_push (state, SvREFCNT_inc_NN (ST (i)));
		2658	}
		2659
		2660	av_push (state, data_sv);
		2661
		2662	api_ready (aTHX_ coro);
		2663	SvREFCNT_dec (coro);
		2664	SvREFCNT_dec ((AV *)state);
		2665	}
		2666
		2667	static int
		2668	slf_check_aio_req (pTHX_ struct CoroSLF *frame)
		2669	{
		2670	AV state = (AV )frame->data;
		2671
		2672	/* if we are about to throw, return early */
		2673	/* this does not cancel the aio request, but at least */
		2674	/* it quickly returns */
		2675	if (CORO_THROW)
		2676	return 0;
		2677
		2678	/* one element that is an RV? repeat! */
		2679	if (AvFILLp (state) == 0 && SvROK (AvARRAY (state)[0]))
		2680	return 1;
		2681
		2682	/* restore status */
		2683	{
		2684	SV *data_sv = av_pop (state);
		2685	struct io_state data = (struct io_state )SvPVX (data_sv);
		2686
		2687	errno = data->errorno;
		2688	PL_laststype = data->laststype;
		2689	PL_laststatval = data->laststatval;
		2690	PL_statcache = data->statcache;
		2691
		2692	SvREFCNT_dec (data_sv);
		2693	}
		2694
		2695	/* push result values */
		2696	{
		2697	dSP;
		2698	int i;
		2699
		2700	EXTEND (SP, AvFILLp (state) + 1);
		2701	for (i = 0; i <= AvFILLp (state); ++i)
		2702	PUSHs (sv_2mortal (SvREFCNT_inc_NN (AvARRAY (state)[i])));
		2703
		2704	PUTBACK;
		2705	}
		2706
		2707	return 0;
		2708	}
		2709
		2710	static void
		2711	slf_init_aio_req (pTHX_ struct CoroSLF frame, CV cv, SV **arg, int items)
		2712	{
		2713	AV state = (AV )sv_2mortal ((SV *)newAV ());
		2714	SV *coro_hv = SvRV (coro_current);
		2715	struct coro *coro = SvSTATE_hv (coro_hv);
		2716
		2717	/* put our coroutine id on the state arg */
		2718	av_push (state, SvREFCNT_inc_NN (coro_hv));
		2719
		2720	/* first see whether we have a non-zero priority and set it as AIO prio */
		2721	if (coro->prio)
		2722	{
		2723	dSP;
		2724
		2725	static SV *prio_cv;
		2726	static SV *prio_sv;
		2727
		2728	if (expect_false (!prio_cv))
		2729	{
		2730	prio_cv = (SV *)get_cv ("IO::AIO::aioreq_pri", 0);
		2731	prio_sv = newSViv (0);
		2732	}
		2733
		2734	PUSHMARK (SP);
		2735	sv_setiv (prio_sv, coro->prio);
		2736	XPUSHs (prio_sv);
		2737
		2738	PUTBACK;
		2739	call_sv (prio_cv, G_VOID \| G_DISCARD);
		2740	}
		2741
		2742	/* now call the original request */
		2743	{
		2744	dSP;
		2745	CV req = (CV )CORO_MAGIC_NN ((SV *)cv, CORO_MAGIC_type_aio)->mg_obj;
		2746	int i;
		2747
		2748	PUSHMARK (SP);
		2749
		2750	/* first push all args to the stack */
		2751	EXTEND (SP, items + 1);
		2752
		2753	for (i = 0; i < items; ++i)
		2754	PUSHs (arg [i]);
		2755
		2756	/* now push the callback closure */
		2757	PUSHs (sv_2mortal (gensub (aTHX_ coro_aio_callback, (void )SvREFCNT_inc_NN ((SV )state))));
		2758
		2759	/* now call the AIO function - we assume our request is uncancelable */
		2760	PUTBACK;
		2761	call_sv ((SV *)req, G_VOID \| G_DISCARD);
		2762	}
		2763
		2764	/* now that the requets is going, we loop toll we have a result */
		2765	frame->data = (void *)state;
		2766	frame->prepare = prepare_schedule;
		2767	frame->check = slf_check_aio_req;
		2768	}
		2769
		2770	static void
		2771	coro_aio_req_xs (pTHX_ CV *cv)
		2772	{
		2773	dXSARGS;
		2774
		2775	CORO_EXECUTE_SLF_XS (slf_init_aio_req);
		2776
		2777	XSRETURN_EMPTY;
		2778	}
		2779
		2780	/*****************************************************************************/
		2781
		2782	#if CORO_CLONE
		2783	# include "clone.c"
		2784	#endif
2068		2785
2069	MODULE = Coro::State PACKAGE = Coro::State PREFIX = api_	2786	MODULE = Coro::State PACKAGE = Coro::State PREFIX = api_
2070		2787
2071	PROTOTYPES: DISABLE	2788	PROTOTYPES: DISABLE
2072		2789
2073	BOOT:	2790	BOOT:
2074	{	2791	{
2075	#ifdef USE_ITHREADS	2792	#ifdef USE_ITHREADS
2076	MUTEX_INIT (&coro_lock);
2077	# if CORO_PTHREAD	2793	# if CORO_PTHREAD
2078	coro_thx = PERL_GET_CONTEXT;	2794	coro_thx = PERL_GET_CONTEXT;
2079	# endif	2795	# endif
2080	#endif	2796	#endif
2081	BOOT_PAGESIZE;	2797	BOOT_PAGESIZE;
		2798
		2799	cctx_current = cctx_new_empty ();
2082		2800
2083	irsgv = gv_fetchpv ("/" , GV_ADD\|GV_NOTQUAL, SVt_PV);	2801	irsgv = gv_fetchpv ("/" , GV_ADD\|GV_NOTQUAL, SVt_PV);
2084	stdoutgv = gv_fetchpv ("STDOUT", GV_ADD\|GV_NOTQUAL, SVt_PVIO);	2802	stdoutgv = gv_fetchpv ("STDOUT", GV_ADD\|GV_NOTQUAL, SVt_PVIO);
2085		2803
2086	orig_sigelem_get = PL_vtbl_sigelem.svt_get; PL_vtbl_sigelem.svt_get = coro_sigelem_get;	2804	orig_sigelem_get = PL_vtbl_sigelem.svt_get; PL_vtbl_sigelem.svt_get = coro_sigelem_get;
…		…
2101	main_mainstack = PL_mainstack;	2819	main_mainstack = PL_mainstack;
2102	main_top_env = PL_top_env;	2820	main_top_env = PL_top_env;
2103		2821
2104	while (main_top_env->je_prev)	2822	while (main_top_env->je_prev)
2105	main_top_env = main_top_env->je_prev;	2823	main_top_env = main_top_env->je_prev;
		2824
		2825	{
		2826	SV *slf = sv_2mortal (newSViv (PTR2IV (pp_slf)));
		2827
		2828	if (!PL_custom_op_names) PL_custom_op_names = newHV ();
		2829	hv_store_ent (PL_custom_op_names, slf, newSVpv ("coro_slf", 0), 0);
		2830
		2831	if (!PL_custom_op_descs) PL_custom_op_descs = newHV ();
		2832	hv_store_ent (PL_custom_op_descs, slf, newSVpv ("coro schedule like function", 0), 0);
		2833	}
2106		2834
2107	coroapi.ver = CORO_API_VERSION;	2835	coroapi.ver = CORO_API_VERSION;
2108	coroapi.rev = CORO_API_REVISION;	2836	coroapi.rev = CORO_API_REVISION;
2109		2837
2110	coroapi.transfer = api_transfer;	2838	coroapi.transfer = api_transfer;
…		…
2128	assert (("PRIO_NORMAL must be 0", !PRIO_NORMAL));	2856	assert (("PRIO_NORMAL must be 0", !PRIO_NORMAL));
2129	}	2857	}
2130		2858
2131	SV *	2859	SV *
2132	new (char *klass, ...)	2860	new (char *klass, ...)
		2861	ALIAS:
		2862	Coro::new = 1
2133	CODE:	2863	CODE:
2134	{	2864	{
2135	struct coro *coro;	2865	struct coro *coro;
2136	MAGIC *mg;	2866	MAGIC *mg;
2137	HV *hv;	2867	HV *hv;
		2868	CV *cb;
2138	int i;	2869	int i;
		2870
		2871	if (items > 1)
		2872	{
		2873	cb = coro_sv_2cv (aTHX_ ST (1));
		2874
		2875	if (!ix)
		2876	{
		2877	if (CvISXSUB (cb))
		2878	croak ("Coro::State doesn't support XS functions as coroutine start, caught");
		2879
		2880	if (!CvROOT (cb))
		2881	croak ("Coro::State doesn't support autoloaded or undefined functions as coroutine start, caught");
		2882	}
		2883	}
2139		2884
2140	Newz (0, coro, 1, struct coro);	2885	Newz (0, coro, 1, struct coro);
2141	coro->args = newAV ();	2886	coro->args = newAV ();
2142	coro->flags = CF_NEW;	2887	coro->flags = CF_NEW;
2143		2888
…		…
2148	coro->hv = hv = newHV ();	2893	coro->hv = hv = newHV ();
2149	mg = sv_magicext ((SV )hv, 0, CORO_MAGIC_type_state, &coro_state_vtbl, (char )coro, 0);	2894	mg = sv_magicext ((SV )hv, 0, CORO_MAGIC_type_state, &coro_state_vtbl, (char )coro, 0);
2150	mg->mg_flags \|= MGf_DUP;	2895	mg->mg_flags \|= MGf_DUP;
2151	RETVAL = sv_bless (newRV_noinc ((SV *)hv), gv_stashpv (klass, 1));	2896	RETVAL = sv_bless (newRV_noinc ((SV *)hv), gv_stashpv (klass, 1));
2152		2897
		2898	if (items > 1)
		2899	{
2153	av_extend (coro->args, items - 1);	2900	av_extend (coro->args, items - 1 + ix - 1);
		2901
		2902	if (ix)
		2903	{
		2904	av_push (coro->args, SvREFCNT_inc_NN ((SV *)cb));
		2905	cb = cv_coro_run;
		2906	}
		2907
		2908	coro->startcv = (CV )SvREFCNT_inc_NN ((SV )cb);
		2909
2154	for (i = 1; i < items; i++)	2910	for (i = 2; i < items; i++)
2155	av_push (coro->args, newSVsv (ST (i)));	2911	av_push (coro->args, newSVsv (ST (i)));
		2912	}
2156	}	2913	}
2157	OUTPUT:	2914	OUTPUT:
2158	RETVAL	2915	RETVAL
2159
2160	void
2161	_set_stacklevel (...)
2162	CODE:
2163	api_execute_slf (aTHX_ cv, slf_init_set_stacklevel, &ST (0), items);
2164		2916
2165	void	2917	void
2166	transfer (...)	2918	transfer (...)
2167	PROTOTYPE: $$	2919	PROTOTYPE: $$
2168	CODE:	2920	CODE:
2169	api_execute_slf (aTHX_ cv, slf_init_transfer, &ST (0), items);	2921	CORO_EXECUTE_SLF_XS (slf_init_transfer);
2170		2922
2171	bool	2923	bool
2172	_destroy (SV *coro_sv)	2924	_destroy (SV *coro_sv)
2173	CODE:	2925	CODE:
2174	RETVAL = coro_state_destroy (aTHX_ SvSTATE (coro_sv));	2926	RETVAL = coro_state_destroy (aTHX_ SvSTATE (coro_sv));
…		…
2178	void	2930	void
2179	_exit (int code)	2931	_exit (int code)
2180	PROTOTYPE: $	2932	PROTOTYPE: $
2181	CODE:	2933	CODE:
2182	_exit (code);	2934	_exit (code);
		2935
		2936	SV *
		2937	clone (Coro::State coro)
		2938	CODE:
		2939	{
		2940	#if CORO_CLONE
		2941	struct coro *ncoro = coro_clone (aTHX_ coro);
		2942	MAGIC *mg;
		2943	/* TODO: too much duplication */
		2944	ncoro->hv = newHV ();
		2945	mg = sv_magicext ((SV )ncoro->hv, 0, CORO_MAGIC_type_state, &coro_state_vtbl, (char )ncoro, 0);
		2946	mg->mg_flags \|= MGf_DUP;
		2947	RETVAL = sv_bless (newRV_noinc ((SV *)ncoro->hv), SvSTASH (coro->hv));
		2948	#else
		2949	croak ("Coro::State->clone has not been configured into this installation of Coro, realised");
		2950	#endif
		2951	}
		2952	OUTPUT:
		2953	RETVAL
2183		2954
2184	int	2955	int
2185	cctx_stacksize (int new_stacksize = 0)	2956	cctx_stacksize (int new_stacksize = 0)
2186	PROTOTYPE: ;$	2957	PROTOTYPE: ;$
2187	CODE:	2958	CODE:
…		…
2292		3063
2293	void	3064	void
2294	throw (Coro::State self, SV *throw = &PL_sv_undef)	3065	throw (Coro::State self, SV *throw = &PL_sv_undef)
2295	PROTOTYPE: $;$	3066	PROTOTYPE: $;$
2296	CODE:	3067	CODE:
		3068	{
		3069	struct coro *current = SvSTATE_current;
		3070	SV **throwp = self == current ? &CORO_THROW : &self->except;
2297	SvREFCNT_dec (self->throw);	3071	SvREFCNT_dec (*throwp);
2298	self->throw = SvOK (throw) ? newSVsv (throw) : 0;	3072	*throwp = SvOK (throw) ? newSVsv (throw) : 0;
		3073	}
2299		3074
2300	void	3075	void
2301	api_trace (SV *coro, int flags = CC_TRACE \| CC_TRACE_SUB)	3076	api_trace (SV *coro, int flags = CC_TRACE \| CC_TRACE_SUB)
2302	PROTOTYPE: $;$	3077	PROTOTYPE: $;$
2303	C_ARGS: aTHX_ coro, flags	3078	C_ARGS: aTHX_ coro, flags
2304		3079
2305	SV *	3080	SV *
2306	has_cctx (Coro::State coro)	3081	has_cctx (Coro::State coro)
2307	PROTOTYPE: $	3082	PROTOTYPE: $
2308	CODE:	3083	CODE:
2309	RETVAL = boolSV (!!coro->cctx);	3084	/* maybe manage the running flag differently */
		3085	RETVAL = boolSV (!!coro->cctx \|\| (coro->flags & CF_RUNNING));
2310	OUTPUT:	3086	OUTPUT:
2311	RETVAL	3087	RETVAL
2312		3088
2313	int	3089	int
2314	is_traced (Coro::State coro)	3090	is_traced (Coro::State coro)
…		…
2334		3110
2335	void	3111	void
2336	force_cctx ()	3112	force_cctx ()
2337	PROTOTYPE:	3113	PROTOTYPE:
2338	CODE:	3114	CODE:
2339	struct coro *coro = SvSTATE (coro_current);
2340	coro->cctx->idle_sp = 0;	3115	cctx_current->idle_sp = 0;
2341		3116
2342	void	3117	void
2343	swap_defsv (Coro::State self)	3118	swap_defsv (Coro::State self)
2344	PROTOTYPE: $	3119	PROTOTYPE: $
2345	ALIAS:	3120	ALIAS:
…		…
2353	SV dst = ix ? (SV )&self->slot->defav : (SV **)&self->slot->defsv;	3128	SV dst = ix ? (SV )&self->slot->defav : (SV **)&self->slot->defsv;
2354		3129
2355	SV tmp = src; src = dst; *dst = tmp;	3130	SV tmp = src; src = dst; *dst = tmp;
2356	}	3131	}
2357		3132
		3133
2358	MODULE = Coro::State PACKAGE = Coro	3134	MODULE = Coro::State PACKAGE = Coro
2359		3135
2360	BOOT:	3136	BOOT:
2361	{	3137	{
2362	int i;	3138	int i;
2363		3139
2364	av_async_pool = coro_get_av (aTHX_ "Coro::async_pool", TRUE);
2365	sv_pool_rss = coro_get_sv (aTHX_ "Coro::POOL_RSS" , TRUE);	3140	sv_pool_rss = coro_get_sv (aTHX_ "Coro::POOL_RSS" , TRUE);
2366	sv_pool_size = coro_get_sv (aTHX_ "Coro::POOL_SIZE" , TRUE);	3141	sv_pool_size = coro_get_sv (aTHX_ "Coro::POOL_SIZE" , TRUE);
2367		3142	cv_coro_run = get_cv ( "Coro::_coro_run" , GV_ADD);
		3143	cv_coro_terminate = get_cv ( "Coro::terminate" , GV_ADD);
2368	coro_current = coro_get_sv (aTHX_ "Coro::current", FALSE);	3144	coro_current = coro_get_sv (aTHX_ "Coro::current" , FALSE); SvREADONLY_on (coro_current);
2369	SvREADONLY_on (coro_current);	3145	av_async_pool = coro_get_av (aTHX_ "Coro::async_pool", TRUE);
		3146	av_destroy = coro_get_av (aTHX_ "Coro::destroy" , TRUE);
		3147	sv_manager = coro_get_sv (aTHX_ "Coro::manager" , TRUE);
		3148	sv_idle = coro_get_sv (aTHX_ "Coro::idle" , TRUE);
		3149
		3150	sv_async_pool_idle = newSVpv ("[async pool idle]", 0); SvREADONLY_on (sv_async_pool_idle);
		3151	sv_Coro = newSVpv ("Coro", 0); SvREADONLY_on (sv_Coro);
		3152	cv_pool_handler = get_cv ("Coro::pool_handler", GV_ADD); SvREADONLY_on (cv_pool_handler);
		3153	cv_coro_state_new = get_cv ("Coro::State::new", 0); SvREADONLY_on (cv_coro_state_new);
2370		3154
2371	coro_stash = gv_stashpv ("Coro", TRUE);	3155	coro_stash = gv_stashpv ("Coro", TRUE);
2372		3156
2373	newCONSTSUB (coro_stash, "PRIO_MAX", newSViv (PRIO_MAX));	3157	newCONSTSUB (coro_stash, "PRIO_MAX", newSViv (PRIO_MAX));
2374	newCONSTSUB (coro_stash, "PRIO_HIGH", newSViv (PRIO_HIGH));	3158	newCONSTSUB (coro_stash, "PRIO_HIGH", newSViv (PRIO_HIGH));
…		…
2382		3166
2383	{	3167	{
2384	SV *sv = coro_get_sv (aTHX_ "Coro::API", TRUE);	3168	SV *sv = coro_get_sv (aTHX_ "Coro::API", TRUE);
2385		3169
2386	coroapi.schedule = api_schedule;	3170	coroapi.schedule = api_schedule;
		3171	coroapi.schedule_to = api_schedule_to;
2387	coroapi.cede = api_cede;	3172	coroapi.cede = api_cede;
2388	coroapi.cede_notself = api_cede_notself;	3173	coroapi.cede_notself = api_cede_notself;
2389	coroapi.ready = api_ready;	3174	coroapi.ready = api_ready;
2390	coroapi.is_ready = api_is_ready;	3175	coroapi.is_ready = api_is_ready;
2391	coroapi.nready = coro_nready;	3176	coroapi.nready = coro_nready;
2392	coroapi.current = coro_current;	3177	coroapi.current = coro_current;
2393		3178
2394	GCoroAPI = &coroapi;	3179	/GCoroAPI = &coroapi;/
2395	sv_setiv (sv, (IV)&coroapi);	3180	sv_setiv (sv, (IV)&coroapi);
2396	SvREADONLY_on (sv);	3181	SvREADONLY_on (sv);
2397	}	3182	}
2398	}	3183	}
2399		3184
2400	void	3185	void
		3186	terminate (...)
		3187	CODE:
		3188	CORO_EXECUTE_SLF_XS (slf_init_terminate);
		3189
		3190	void
2401	schedule (...)	3191	schedule (...)
2402	CODE:	3192	CODE:
2403	api_execute_slf (aTHX_ cv, slf_init_schedule, &ST (0), 0);	3193	CORO_EXECUTE_SLF_XS (slf_init_schedule);
		3194
		3195	void
		3196	schedule_to (...)
		3197	CODE:
		3198	CORO_EXECUTE_SLF_XS (slf_init_schedule_to);
		3199
		3200	void
		3201	cede_to (...)
		3202	CODE:
		3203	CORO_EXECUTE_SLF_XS (slf_init_cede_to);
2404		3204
2405	void	3205	void
2406	cede (...)	3206	cede (...)
2407	CODE:	3207	CODE:
2408	api_execute_slf (aTHX_ cv, slf_init_cede, &ST (0), 0);	3208	CORO_EXECUTE_SLF_XS (slf_init_cede);
2409		3209
2410	void	3210	void
2411	cede_notself (...)	3211	cede_notself (...)
2412	CODE:	3212	CODE:
2413	api_execute_slf (aTHX_ cv, slf_init_cede_notself, &ST (0), 0);	3213	CORO_EXECUTE_SLF_XS (slf_init_cede_notself);
		3214
		3215	void
		3216	_cancel (Coro::State self)
		3217	CODE:
		3218	coro_state_destroy (aTHX_ self);
		3219	coro_call_on_destroy (aTHX_ self);
2414		3220
2415	void	3221	void
2416	_set_current (SV *current)	3222	_set_current (SV *current)
2417	PROTOTYPE: $	3223	PROTOTYPE: $
2418	CODE:	3224	CODE:
…		…
2421		3227
2422	void	3228	void
2423	_set_readyhook (SV *hook)	3229	_set_readyhook (SV *hook)
2424	PROTOTYPE: $	3230	PROTOTYPE: $
2425	CODE:	3231	CODE:
2426	LOCK;
2427	SvREFCNT_dec (coro_readyhook);	3232	SvREFCNT_dec (coro_readyhook);
2428	coro_readyhook = SvOK (hook) ? newSVsv (hook) : 0;	3233	coro_readyhook = SvOK (hook) ? newSVsv (hook) : 0;
2429	UNLOCK;
2430		3234
2431	int	3235	int
2432	prio (Coro::State coro, int newprio = 0)	3236	prio (Coro::State coro, int newprio = 0)
2433	PROTOTYPE: $;$	3237	PROTOTYPE: $;$
2434	ALIAS:	3238	ALIAS:
…		…
2465	CODE:	3269	CODE:
2466	RETVAL = coro_nready;	3270	RETVAL = coro_nready;
2467	OUTPUT:	3271	OUTPUT:
2468	RETVAL	3272	RETVAL
2469		3273
2470	# for async_pool speedup
2471	void	3274	void
2472	_pool_1 (SV *cb)	3275	_pool_handler (...)
2473	CODE:	3276	CODE:
2474	{	3277	CORO_EXECUTE_SLF_XS (slf_init_pool_handler);
2475	struct coro *coro = SvSTATE (coro_current);
2476	HV hv = (HV )SvRV (coro_current);
2477	AV *defav = GvAV (PL_defgv);
2478	SV *invoke = hv_delete (hv, "_invoke", sizeof ("_invoke") - 1, 0);
2479	AV *invoke_av;
2480	int i, len;
2481		3278
2482	if (!invoke)	3279	void
		3280	async_pool (SV *cv, ...)
		3281	PROTOTYPE: &@
		3282	PPCODE:
		3283	{
		3284	HV hv = (HV )av_pop (av_async_pool);
		3285	AV *av = newAV ();
		3286	SV *cb = ST (0);
		3287	int i;
		3288
		3289	av_extend (av, items - 2);
		3290	for (i = 1; i < items; ++i)
		3291	av_push (av, SvREFCNT_inc_NN (ST (i)));
		3292
		3293	if ((SV *)hv == &PL_sv_undef)
2483	{	3294	{
2484	SV *old = PL_diehook;	3295	PUSHMARK (SP);
2485	PL_diehook = 0;	3296	EXTEND (SP, 2);
2486	SvREFCNT_dec (old);	3297	PUSHs (sv_Coro);
2487	croak ("\3async_pool terminate\2\n");	3298	PUSHs ((SV *)cv_pool_handler);
		3299	PUTBACK;
		3300	call_sv ((SV *)cv_coro_state_new, G_SCALAR);
		3301	SPAGAIN;
		3302
		3303	hv = (HV *)SvREFCNT_inc_NN (SvRV (POPs));
2488	}	3304	}
2489		3305
2490	SvREFCNT_dec (coro->saved_deffh);
2491	coro->saved_deffh = SvREFCNT_inc_NN ((SV *)PL_defoutgv);
2492
2493	hv_store (hv, "desc", sizeof ("desc") - 1,
2494	newSVpvn ("[async_pool]", sizeof ("[async_pool]") - 1), 0);
2495
2496	invoke_av = (AV *)SvRV (invoke);
2497	len = av_len (invoke_av);
2498
2499	sv_setsv (cb, AvARRAY (invoke_av)[0]);
2500
2501	if (len > 0)
2502	{	3306	{
2503	av_fill (defav, len - 1);	3307	struct coro *coro = SvSTATE_hv (hv);
2504	for (i = 0; i < len; ++i)	3308
2505	av_store (defav, i, SvREFCNT_inc_NN (AvARRAY (invoke_av)[i + 1]));	3309	assert (!coro->invoke_cb);
		3310	assert (!coro->invoke_av);
		3311	coro->invoke_cb = SvREFCNT_inc (cb);
		3312	coro->invoke_av = av;
2506	}	3313	}
2507	}
2508		3314
2509	void	3315	api_ready (aTHX_ (SV *)hv);
2510	_pool_2 (SV *cb)	3316
		3317	if (GIMME_V != G_VOID)
		3318	XPUSHs (sv_2mortal (newRV_noinc ((SV *)hv)));
		3319	else
		3320	SvREFCNT_dec (hv);
		3321	}
		3322
		3323	SV *
		3324	rouse_cb ()
		3325	PROTOTYPE:
2511	CODE:	3326	CODE:
2512	{	3327	RETVAL = coro_new_rouse_cb (aTHX);
2513	struct coro *coro = SvSTATE (coro_current);
2514
2515	sv_setsv (cb, &PL_sv_undef);
2516
2517	SvREFCNT_dec ((SV )PL_defoutgv); PL_defoutgv = (GV )coro->saved_deffh;
2518	coro->saved_deffh = 0;
2519
2520	if (coro_rss (aTHX_ coro) > SvUV (sv_pool_rss)
2521	\|\| av_len (av_async_pool) + 1 >= SvIV (sv_pool_size))
2522	{
2523	SV *old = PL_diehook;
2524	PL_diehook = 0;
2525	SvREFCNT_dec (old);
2526	croak ("\3async_pool terminate\2\n");
2527	}
2528
2529	av_clear (GvAV (PL_defgv));
2530	hv_store ((HV *)SvRV (coro_current), "desc", sizeof ("desc") - 1,
2531	newSVpvn ("[async_pool idle]", sizeof ("[async_pool idle]") - 1), 0);
2532
2533	coro->prio = 0;
2534
2535	if (coro->cctx && (coro->cctx->flags & CC_TRACE))
2536	api_trace (aTHX_ coro_current, 0);
2537
2538	av_push (av_async_pool, newSVsv (coro_current));
2539	}
2540
2541	#if 0
2542
2543	void
2544	_generator_call (...)
2545	PROTOTYPE: @
2546	PPCODE:
2547	fprintf (stderr, "call %p\n", CvXSUBANY(cv).any_ptr);
2548	xxxx
2549	abort ();
2550
2551	SV *
2552	gensub (SV *sub, ...)
2553	PROTOTYPE: &;@
2554	CODE:
2555	{
2556	struct coro *coro;
2557	MAGIC *mg;
2558	CV *xcv;
2559	CV ncv = (CV )newSV_type (SVt_PVCV);
2560	int i;
2561
2562	CvGV (ncv) = CvGV (cv);
2563	CvFILE (ncv) = CvFILE (cv);
2564
2565	Newz (0, coro, 1, struct coro);
2566	coro->args = newAV ();
2567	coro->flags = CF_NEW;
2568
2569	av_extend (coro->args, items - 1);
2570	for (i = 1; i < items; i++)
2571	av_push (coro->args, newSVsv (ST (i)));
2572
2573	CvISXSUB_on (ncv);
2574	CvXSUBANY (ncv).any_ptr = (void *)coro;
2575
2576	xcv = GvCV (gv_fetchpv ("Coro::_generator_call", 0, SVt_PVCV));
2577
2578	CvXSUB (ncv) = CvXSUB (xcv);
2579	CvANON_on (ncv);
2580
2581	mg = sv_magicext ((SV )ncv, 0, CORO_MAGIC_type_state, &coro_gensub_vtbl, (char )coro, 0);
2582	RETVAL = newRV_noinc ((SV *)ncv);
2583	}
2584	OUTPUT:	3328	OUTPUT:
2585	RETVAL	3329	RETVAL
2586		3330
2587	#endif
2588
2589
2590	MODULE = Coro::State PACKAGE = Coro::AIO
2591
2592	void	3331	void
2593	_get_state (SV *self)	3332	rouse_wait (...)
2594	PROTOTYPE: $	3333	PROTOTYPE: ;$
2595	PPCODE:	3334	PPCODE:
2596	{	3335	CORO_EXECUTE_SLF_XS (slf_init_rouse_wait);
2597	AV *defav = GvAV (PL_defgv);
2598	AV *av = newAV ();
2599	int i;
2600	SV *data_sv = newSV (sizeof (struct io_state));
2601	struct io_state data = (struct io_state )SvPVX (data_sv);
2602	SvCUR_set (data_sv, sizeof (struct io_state));
2603	SvPOK_only (data_sv);
2604
2605	data->errorno = errno;
2606	data->laststype = PL_laststype;
2607	data->laststatval = PL_laststatval;
2608	data->statcache = PL_statcache;
2609
2610	av_extend (av, AvFILLp (defav) + 1 + 1);
2611
2612	for (i = 0; i <= AvFILLp (defav); ++i)
2613	av_push (av, SvREFCNT_inc_NN (AvARRAY (defav)[i]));
2614
2615	av_push (av, data_sv);
2616
2617	XPUSHs (sv_2mortal (newRV_noinc ((SV *)av)));
2618
2619	api_ready (aTHX_ self);
2620	}
2621
2622	void
2623	_set_state (SV *state)
2624	PROTOTYPE: $
2625	PPCODE:
2626	{
2627	AV av = (AV )SvRV (state);
2628	struct io_state data = (struct io_state )SvPVX (AvARRAY (av)[AvFILLp (av)]);
2629	int i;
2630
2631	errno = data->errorno;
2632	PL_laststype = data->laststype;
2633	PL_laststatval = data->laststatval;
2634	PL_statcache = data->statcache;
2635
2636	EXTEND (SP, AvFILLp (av));
2637	for (i = 0; i < AvFILLp (av); ++i)
2638	PUSHs (sv_2mortal (SvREFCNT_inc_NN (AvARRAY (av)[i])));
2639	}
2640
2641
2642	MODULE = Coro::State PACKAGE = Coro::AnyEvent
2643
2644	BOOT:
2645	sv_activity = coro_get_sv (aTHX_ "Coro::AnyEvent::ACTIVITY", TRUE);
2646
2647	void
2648	_schedule (...)
2649	CODE:
2650	{
2651	static int incede;
2652
2653	api_cede_notself (aTHX);
2654
2655	++incede;
2656	while (coro_nready >= incede && api_cede (aTHX))
2657	;
2658
2659	sv_setsv (sv_activity, &PL_sv_undef);
2660	if (coro_nready >= incede)
2661	{
2662	PUSHMARK (SP);
2663	PUTBACK;
2664	call_pv ("Coro::AnyEvent::_activity", G_DISCARD \| G_EVAL);
2665	SPAGAIN;
2666	}
2667
2668	--incede;
2669	}
2670		3336
2671		3337
2672	MODULE = Coro::State PACKAGE = PerlIO::cede	3338	MODULE = Coro::State PACKAGE = PerlIO::cede
2673		3339
2674	BOOT:	3340	BOOT:
2675	PerlIO_define_layer (aTHX_ &PerlIO_cede);	3341	PerlIO_define_layer (aTHX_ &PerlIO_cede);
2676		3342
		3343
2677	MODULE = Coro::State PACKAGE = Coro::Semaphore	3344	MODULE = Coro::State PACKAGE = Coro::Semaphore
2678		3345
2679	SV *	3346	SV *
2680	new (SV klass, SV count_ = 0)	3347	new (SV klass, SV count = 0)
2681	CODE:	3348	CODE:
2682	{	3349	RETVAL = sv_bless (
2683	/* a semaphore contains a counter IV in $sem->[0] and any waiters after that */	3350	coro_waitarray_new (aTHX_ count && SvOK (count) ? SvIV (count) : 1),
2684	AV *av = newAV ();	3351	GvSTASH (CvGV (cv))
2685	av_push (av, newSViv (count_ && SvOK (count_) ? SvIV (count_) : 1));	3352	);
2686	RETVAL = sv_bless (newRV_noinc ((SV *)av), GvSTASH (CvGV (cv)));	3353	OUTPUT:
2687	}	3354	RETVAL
		3355
		3356	# helper for Coro::Channel
		3357	SV *
		3358	_alloc (int count)
		3359	CODE:
		3360	RETVAL = coro_waitarray_new (aTHX_ count);
2688	OUTPUT:	3361	OUTPUT:
2689	RETVAL	3362	RETVAL
2690		3363
2691	SV *	3364	SV *
2692	count (SV *self)	3365	count (SV *self)
…		…
2698	void	3371	void
2699	up (SV *self, int adjust = 1)	3372	up (SV *self, int adjust = 1)
2700	ALIAS:	3373	ALIAS:
2701	adjust = 1	3374	adjust = 1
2702	CODE:	3375	CODE:
2703	{	3376	coro_semaphore_adjust (aTHX_ (AV *)SvRV (self), ix ? adjust : 1);
2704	AV av = (AV )SvRV (self);
2705	SV *count_sv = AvARRAY (av)[0];
2706	IV count = SvIVX (count_sv);
2707
2708	count += ix ? adjust : 1;
2709	SvIVX (count_sv) = count;
2710
2711	/* now wake up as many waiters as possible */
2712	while (count > 0 && AvFILLp (av) >= count)
2713	{
2714	SV *cb;
2715
2716	/* swap first two elements so we can shift a waiter */
2717	AvARRAY (av)[0] = AvARRAY (av)[1];
2718	AvARRAY (av)[1] = count_sv;
2719	cb = av_shift (av);
2720
2721	if (SvOBJECT (cb))
2722	api_ready (aTHX_ cb);
2723	else
2724	croak ("callbacks not yet supported");
2725
2726	SvREFCNT_dec (cb);
2727	}
2728	}
2729		3377
2730	void	3378	void
2731	down (SV *self)	3379	down (...)
2732	CODE:	3380	CODE:
2733	api_execute_slf (aTHX_ cv, slf_init_semaphore_down, &ST (0), 1);	3381	CORO_EXECUTE_SLF_XS (slf_init_semaphore_down);
		3382
		3383	void
		3384	wait (...)
		3385	CODE:
		3386	CORO_EXECUTE_SLF_XS (slf_init_semaphore_wait);
2734		3387
2735	void	3388	void
2736	try (SV *self)	3389	try (SV *self)
2737	PPCODE:	3390	PPCODE:
2738	{	3391	{
…		…
2750	XSRETURN_NO;	3403	XSRETURN_NO;
2751	}	3404	}
2752		3405
2753	void	3406	void
2754	waiters (SV *self)	3407	waiters (SV *self)
2755	CODE:	3408	PPCODE:
2756	{	3409	{
2757	AV av = (AV )SvRV (self);	3410	AV av = (AV )SvRV (self);
		3411	int wcount = AvFILLp (av) + 1 - 1;
2758		3412
2759	if (GIMME_V == G_SCALAR)	3413	if (GIMME_V == G_SCALAR)
2760	XPUSHs (sv_2mortal (newSVsv (AvARRAY (av)[0])));	3414	XPUSHs (sv_2mortal (newSViv (wcount)));
2761	else	3415	else
2762	{	3416	{
2763	int i;	3417	int i;
2764	EXTEND (SP, AvFILLp (av) + 1 - 1);	3418	EXTEND (SP, wcount);
2765	for (i = 1; i <= AvFILLp (av); ++i)	3419	for (i = 1; i <= wcount; ++i)
2766	PUSHs (newSVsv (AvARRAY (av)[i]));	3420	PUSHs (sv_2mortal (newRV_inc (AvARRAY (av)[i])));
2767	}	3421	}
2768	}	3422	}
2769		3423
		3424	MODULE = Coro::State PACKAGE = Coro::Signal
		3425
		3426	SV *
		3427	new (SV *klass)
		3428	CODE:
		3429	RETVAL = sv_bless (
		3430	coro_waitarray_new (aTHX_ 0),
		3431	GvSTASH (CvGV (cv))
		3432	);
		3433	OUTPUT:
		3434	RETVAL
		3435
		3436	void
		3437	wait (...)
		3438	CODE:
		3439	CORO_EXECUTE_SLF_XS (slf_init_signal_wait);
		3440
		3441	void
		3442	broadcast (SV *self)
		3443	CODE:
		3444	{
		3445	AV av = (AV )SvRV (self);
		3446	coro_signal_wake (aTHX_ av, AvFILLp (av));
		3447	}
		3448
		3449	void
		3450	send (SV *self)
		3451	CODE:
		3452	{
		3453	AV av = (AV )SvRV (self);
		3454
		3455	if (AvFILLp (av))
		3456	coro_signal_wake (aTHX_ av, 1);
		3457	else
		3458	SvIVX (AvARRAY (av)[0]) = 1; /* remember the signal */
		3459	}
		3460
		3461	IV
		3462	awaited (SV *self)
		3463	CODE:
		3464	RETVAL = AvFILLp ((AV *)SvRV (self)) + 1 - 1;
		3465	OUTPUT:
		3466	RETVAL
		3467
		3468
		3469	MODULE = Coro::State PACKAGE = Coro::AnyEvent
		3470
		3471	BOOT:
		3472	sv_activity = coro_get_sv (aTHX_ "Coro::AnyEvent::ACTIVITY", TRUE);
		3473
		3474	void
		3475	_schedule (...)
		3476	CODE:
		3477	{
		3478	static int incede;
		3479
		3480	api_cede_notself (aTHX);
		3481
		3482	++incede;
		3483	while (coro_nready >= incede && api_cede (aTHX))
		3484	;
		3485
		3486	sv_setsv (sv_activity, &PL_sv_undef);
		3487	if (coro_nready >= incede)
		3488	{
		3489	PUSHMARK (SP);
		3490	PUTBACK;
		3491	call_pv ("Coro::AnyEvent::_activity", G_KEEPERR \| G_EVAL \| G_VOID \| G_DISCARD);
		3492	}
		3493
		3494	--incede;
		3495	}
		3496
		3497
		3498	MODULE = Coro::State PACKAGE = Coro::AIO
		3499
		3500	void
		3501	_register (char target, char proto, SV *req)
		3502	CODE:
		3503	{
		3504	CV *req_cv = coro_sv_2cv (aTHX_ req);
		3505	/* newXSproto doesn't return the CV on 5.8 */
		3506	CV *slf_cv = newXS (target, coro_aio_req_xs, __FILE__);
		3507	sv_setpv ((SV *)slf_cv, proto);
		3508	sv_magicext ((SV )slf_cv, (SV )req_cv, CORO_MAGIC_type_aio, 0, 0, 0);
		3509	}
		3510

Diff Legend

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

Comparing Coro/Coro/State.xs (file contents): Revision 1.277 by root, Sat Nov 15 18:40:55 2008 UTC vs. Revision 1.337 by root, Fri Dec 5 18:26:10 2008 UTC

Diff Legend

Comparing Coro/Coro/State.xs (file contents):
Revision 1.277 by root, Sat Nov 15 18:40:55 2008 UTC vs.
Revision 1.337 by root, Fri Dec 5 18:26:10 2008 UTC