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

Comparing Coro/Coro/State.xs (file contents):
Revision 1.405 by root, Sat Jun 11 13:01:26 2011 UTC vs.
Revision 1.425 by root, Wed Dec 5 00:14:22 2012 UTC

…		…
12	#include "perl.h"	12	#include "perl.h"
13	#include "XSUB.h"	13	#include "XSUB.h"
14	#include "perliol.h"	14	#include "perliol.h"
15		15
16	#include "schmorp.h"	16	#include "schmorp.h"
		17
		18	#define ECB_NO_THREADS 1
17	#include "ecb.h"	19	#include "ecb.h"
18		20
19	#include <stddef.h>	21	#include <stddef.h>
20	#include <stdio.h>	22	#include <stdio.h>
21	#include <errno.h>	23	#include <errno.h>
22	#include <assert.h>	24	#include <assert.h>
23		25
24	#ifndef SVs_PADSTALE	26	#ifndef SVs_PADSTALE
25	# define SVs_PADSTALE 0	27	# define SVs_PADSTALE 0
		28	#endif
		29
		30	#ifdef PadARRAY
		31	# define NEWPADAPI
		32	# define newPADLIST(var) (Newz (0, var, 1, PADLIST), Newx (PadlistARRAY (var), 2, PAD *))
		33	#else
		34	typedef AV PADNAMELIST;
		35	# if !PERL_VERSION_ATLEAST(5,8,0)
		36	typedef AV PADLIST;
		37	typedef AV PAD;
		38	# endif
		39	# define PadlistARRAY(pl) ((PAD **)AvARRAY (pl))
		40	# define PadlistMAX(pl) AvFILLp (pl)
		41	# define PadlistNAMES(pl) (*PadlistARRAY (pl))
		42	# define PadARRAY AvARRAY
		43	# define PadMAX AvFILLp
		44	# define newPADLIST(var) ((var) = newAV (), av_extend (var, 1))
26	#endif	45	#endif
27		46
28	#if defined(_WIN32)	47	#if defined(_WIN32)
29	# undef HAS_GETTIMEOFDAY	48	# undef HAS_GETTIMEOFDAY
30	# undef setjmp	49	# undef setjmp
…		…
33	# define setjmp _setjmp /* deep magic */	52	# define setjmp _setjmp /* deep magic */
34	#else	53	#else
35	# include <inttypes.h> /* most portable stdint.h */	54	# include <inttypes.h> /* most portable stdint.h */
36	#endif	55	#endif
37		56
38	#ifdef HAVE_MMAP	57	#if HAVE_MMAP
39	# include <unistd.h>	58	# include <unistd.h>
40	# include <sys/mman.h>	59	# include <sys/mman.h>
41	# ifndef MAP_ANONYMOUS	60	# ifndef MAP_ANONYMOUS
42	# ifdef MAP_ANON	61	# ifdef MAP_ANON
43	# define MAP_ANONYMOUS MAP_ANON	62	# define MAP_ANONYMOUS MAP_ANON
…		…
63	#endif	82	#endif
64		83
65	/* the maximum number of idle cctx that will be pooled */	84	/* the maximum number of idle cctx that will be pooled */
66	static int cctx_max_idle = 4;	85	static int cctx_max_idle = 4;
67		86
		87	#if defined(DEBUGGING) && PERL_VERSION_ATLEAST(5,12,0)
		88	# define HAS_SCOPESTACK_NAME 1
		89	#endif
		90
68	#if !__i386 && !__x86_64 && !__powerpc && !__m68k && !__alpha && !__mips && !__sparc64	91	#if !__i386 && !__x86_64 && !__powerpc && !__m68k && !__alpha && !__mips && !__sparc64
69	# undef CORO_STACKGUARD	92	# undef CORO_STACKGUARD
70	#endif	93	#endif
71		94
72	#ifndef CORO_STACKGUARD	95	#ifndef CORO_STACKGUARD
…		…
97	# if CORO_PTHREAD	120	# if CORO_PTHREAD
98	static void *coro_thx;	121	static void *coro_thx;
99	# endif	122	# endif
100	#endif	123	#endif
101		124
102	/* used in state.h */
103	#define VAR(name,type) VARx(name, PL_ ## name, type)
104
105	#ifdef __linux	125	#ifdef __linux
106	# include <time.h> /* for timespec */	126	# include <time.h> /* for timespec */
107	# include <syscall.h> /* for SYS_* */	127	# include <syscall.h> /* for SYS_* */
108	# ifdef SYS_clock_gettime	128	# ifdef SYS_clock_gettime
109	# define coro_clock_gettime(id, ts) syscall (SYS_clock_gettime, (id), (ts))	129	# define coro_clock_gettime(id, ts) syscall (SYS_clock_gettime, (id), (ts))
…		…
177	void *sptr;	197	void *sptr;
178	size_t ssize;	198	size_t ssize;
179		199
180	/* cpu state */	200	/* cpu state */
181	void idle_sp; / sp of top-level transfer/schedule/cede call */	201	void idle_sp; / sp of top-level transfer/schedule/cede call */
		202	#ifndef NDEBUG
182	JMPENV idle_te; / same as idle_sp, but for top_env, TODO: remove once stable */	203	JMPENV idle_te; / same as idle_sp, but for top_env */
		204	#endif
183	JMPENV *top_env;	205	JMPENV *top_env;
184	coro_context cctx;	206	coro_context cctx;
185		207
186	U32 gen;	208	U32 gen;
187	#if CORO_USE_VALGRIND	209	#if CORO_USE_VALGRIND
…		…
207	};	229	};
208		230
209	/* the structure where most of the perl state is stored, overlaid on the cxstack */	231	/* the structure where most of the perl state is stored, overlaid on the cxstack */
210	typedef struct	232	typedef struct
211	{	233	{
212	#define VARx(name,expr,type) type name;	234	#define VARx(name,expr,type) type name;
213	# include "state.h"	235	#include "state.h"
214	#undef VARx
215	} perl_slots;	236	} perl_slots;
216		237
217	// how many context stack entries do we need for perl_slots	238	/* how many context stack entries do we need for perl_slots */
218	#define SLOT_COUNT ((sizeof (perl_slots) + sizeof (PERL_CONTEXT) - 1) / sizeof (PERL_CONTEXT))	239	#define SLOT_COUNT ((sizeof (perl_slots) + sizeof (PERL_CONTEXT) - 1) / sizeof (PERL_CONTEXT))
219		240
220	/* this is a structure representing a perl-level coroutine */	241	/* this is a structure representing a perl-level coroutine */
221	struct coro	242	struct coro
222	{	243	{
…		…
291	#define coro_nready coroapi.nready	312	#define coro_nready coroapi.nready
292		313
293	/ JIT *******************************************************************/	314	/ JIT *******************************************************************/
294		315
295	#if CORO_JIT	316	#if CORO_JIT
		317	/* APPLE doesn't have HAVE_MMAP though */
		318	#define CORO_JIT_UNIXY (__linux \|\| __FreeBSD__ \|\| __OpenBSD__ \|\| __NetBSD__ \|\| __solaris \|\| __APPLE__)
296	#ifndef CORO_JIT_TYPE	319	#ifndef CORO_JIT_TYPE
297	#if __linux && __amd64	320	#if __x86_64 && CORO_JIT_UNIXY
298	#define CORO_JIT_TYPE "amd64-unix"	321	#define CORO_JIT_TYPE "amd64-unix"
299	typedef void (load_save_perl_slots_type)(perl_slots );	322	#elif __i386 && CORO_JIT_UNIXY
300	#else	323	#define CORO_JIT_TYPE "x86-unix"
301	#undef CORO_JIT
302	#endif	324	#endif
303	#endif	325	#endif
304	#endif	326	#endif
305		327
		328	#if !defined(CORO_JIT_TYPE) \|\| !HAVE_MMAP
		329	#undef CORO_JIT
		330	#endif
		331
306	#if CORO_JIT	332	#if CORO_JIT
307		333	typedef void (load_save_perl_slots_type)(perl_slots );
308	static load_save_perl_slots_type load_perl_slots, save_perl_slots;	334	static load_save_perl_slots_type load_perl_slots, save_perl_slots;
309
310	#endif	335	#endif
311		336
312	/ Coro::Select **********************************************************/	337	/ Coro::Select **********************************************************/
313		338
314	static OP (coro_old_pp_sselect) (pTHX);	339	static OP (coro_old_pp_sselect) (pTHX);
…		…
331		356
332	/ time stuff ************************************************************/	357	/ time stuff ************************************************************/
333		358
334	#ifdef HAS_GETTIMEOFDAY	359	#ifdef HAS_GETTIMEOFDAY
335		360
336	ECB_INLINE void	361	ecb_inline void
337	coro_u2time (pTHX_ UV ret[2])	362	coro_u2time (pTHX_ UV ret[2])
338	{	363	{
339	struct timeval tv;	364	struct timeval tv;
340	gettimeofday (&tv, 0);	365	gettimeofday (&tv, 0);
341		366
342	ret [0] = tv.tv_sec;	367	ret [0] = tv.tv_sec;
343	ret [1] = tv.tv_usec;	368	ret [1] = tv.tv_usec;
344	}	369	}
345		370
346	ECB_INLINE double	371	ecb_inline double
347	coro_nvtime ()	372	coro_nvtime (void)
348	{	373	{
349	struct timeval tv;	374	struct timeval tv;
350	gettimeofday (&tv, 0);	375	gettimeofday (&tv, 0);
351		376
352	return tv.tv_sec + tv.tv_usec * 1e-6;	377	return tv.tv_sec + tv.tv_usec * 1e-6;
353	}	378	}
354		379
355	ECB_INLINE void	380	ecb_inline void
356	time_init (pTHX)	381	time_init (pTHX)
357	{	382	{
358	nvtime = coro_nvtime;	383	nvtime = coro_nvtime;
359	u2time = coro_u2time;	384	u2time = coro_u2time;
360	}	385	}
361		386
362	#else	387	#else
363		388
364	ECB_INLINE void	389	ecb_inline void
365	time_init (pTHX)	390	time_init (pTHX)
366	{	391	{
367	SV **svp;	392	SV **svp;
368		393
369	require_pv ("Time/HiRes.pm");	394	require_pv ("Time/HiRes.pm");
370		395
371	svp = hv_fetch (PL_modglobal, "Time::NVtime", 12, 0);	396	svp = hv_fetch (PL_modglobal, "Time::NVtime", 12, 0);
372		397
373	if (!svp) croak ("Time::HiRes is required, but missing. Caught");	398	if (!svp) croak ("Time::HiRes is required, but missing. Caught");
374	if (!SvIOK (*svp)) croak ("Time::NVtime isn't a function pointer. Caught");	399	if (!SvIOK (*svp)) croak ("Time::NVtime isn't a function pointer. Caught");
375		400
…		…
411	get_hv (name, create);	436	get_hv (name, create);
412	#endif	437	#endif
413	return get_hv (name, create);	438	return get_hv (name, create);
414	}	439	}
415		440
416	ECB_INLINE void	441	ecb_inline void
417	coro_times_update ()	442	coro_times_update (void)
418	{	443	{
419	#ifdef coro_clock_gettime	444	#ifdef coro_clock_gettime
420	struct timespec ts;	445	struct timespec ts;
421		446
422	ts.tv_sec = ts.tv_nsec = 0;	447	ts.tv_sec = ts.tv_nsec = 0;
…		…
434	time_real [0] = tv [0];	459	time_real [0] = tv [0];
435	time_real [1] = tv [1] * 1000;	460	time_real [1] = tv [1] * 1000;
436	#endif	461	#endif
437	}	462	}
438		463
439	ECB_INLINE void	464	ecb_inline void
440	coro_times_add (struct coro *c)	465	coro_times_add (struct coro *c)
441	{	466	{
442	c->t_real [1] += time_real [1];	467	c->t_real [1] += time_real [1];
443	if (c->t_real [1] > 1000000000) { c->t_real [1] -= 1000000000; ++c->t_real [0]; }	468	if (c->t_real [1] > 1000000000) { c->t_real [1] -= 1000000000; ++c->t_real [0]; }
444	c->t_real [0] += time_real [0];	469	c->t_real [0] += time_real [0];
…		…
446	c->t_cpu [1] += time_cpu [1];	471	c->t_cpu [1] += time_cpu [1];
447	if (c->t_cpu [1] > 1000000000) { c->t_cpu [1] -= 1000000000; ++c->t_cpu [0]; }	472	if (c->t_cpu [1] > 1000000000) { c->t_cpu [1] -= 1000000000; ++c->t_cpu [0]; }
448	c->t_cpu [0] += time_cpu [0];	473	c->t_cpu [0] += time_cpu [0];
449	}	474	}
450		475
451	ECB_INLINE void	476	ecb_inline void
452	coro_times_sub (struct coro *c)	477	coro_times_sub (struct coro *c)
453	{	478	{
454	if (c->t_real [1] < time_real [1]) { c->t_real [1] += 1000000000; --c->t_real [0]; }	479	if (c->t_real [1] < time_real [1]) { c->t_real [1] += 1000000000; --c->t_real [0]; }
455	c->t_real [1] -= time_real [1];	480	c->t_real [1] -= time_real [1];
456	c->t_real [0] -= time_real [0];	481	c->t_real [0] -= time_real [0];
…		…
477	: 0)	502	: 0)
478		503
479	#define CORO_MAGIC_cv(cv) CORO_MAGIC (((SV *)(cv)), CORO_MAGIC_type_cv)	504	#define CORO_MAGIC_cv(cv) CORO_MAGIC (((SV *)(cv)), CORO_MAGIC_type_cv)
480	#define CORO_MAGIC_state(sv) CORO_MAGIC_NN (((SV *)(sv)), CORO_MAGIC_type_state)	505	#define CORO_MAGIC_state(sv) CORO_MAGIC_NN (((SV *)(sv)), CORO_MAGIC_type_state)
481		506
482	ECB_INLINE MAGIC *	507	ecb_inline MAGIC *
483	SvSTATEhv_p (pTHX_ SV *coro)	508	SvSTATEhv_p (pTHX_ SV *coro)
484	{	509	{
485	MAGIC *mg;	510	MAGIC *mg;
486		511
487	if (ecb_expect_true (	512	if (ecb_expect_true (
…		…
492	return mg;	517	return mg;
493		518
494	return 0;	519	return 0;
495	}	520	}
496		521
497	ECB_INLINE struct coro *	522	ecb_inline struct coro *
498	SvSTATE_ (pTHX_ SV *coro)	523	SvSTATE_ (pTHX_ SV *coro)
499	{	524	{
500	MAGIC *mg;	525	MAGIC *mg;
501		526
502	if (SvROK (coro))	527	if (SvROK (coro))
…		…
516	#define SvSTATE_current SvSTATE_hv (SvRV (coro_current))	541	#define SvSTATE_current SvSTATE_hv (SvRV (coro_current))
517		542
518	/*****************************************************************************/	543	/*****************************************************************************/
519	/* padlist management and caching */	544	/* padlist management and caching */
520		545
521	ECB_INLINE AV *	546	ecb_inline PADLIST *
522	coro_derive_padlist (pTHX_ CV *cv)	547	coro_derive_padlist (pTHX_ CV *cv)
523	{	548	{
524	AV *padlist = CvPADLIST (cv);	549	PADLIST *padlist = CvPADLIST (cv);
525	AV newpadlist, newpad;	550	PADLIST *newpadlist;
		551	PAD *newpad;
		552	PADOFFSET const off = PadlistMAX (padlist) + 1;
526		553
527	newpadlist = newAV ();	554	newPADLIST(newpadlist);
		555	#if !PERL_VERSION_ATLEAST(5,15,3)
		556	/* Padlists are AvREAL as of 5.15.3. See perl bug #98092 and perl commit 7d953ba. */
528	AvREAL_off (newpadlist);	557	AvREAL_off (newpadlist);
		558	#endif
529	#if PERL_VERSION_ATLEAST (5,10,0)	559	#if PERL_VERSION_ATLEAST (5,10,0)
530	Perl_pad_push (aTHX_ padlist, AvFILLp (padlist) + 1);	560	Perl_pad_push (aTHX_ padlist, off);
531	#else	561	#else
532	Perl_pad_push (aTHX_ padlist, AvFILLp (padlist) + 1, 1);	562	Perl_pad_push (aTHX_ padlist, off, 1);
533	#endif	563	#endif
534	newpad = (AV *)AvARRAY (padlist)[AvFILLp (padlist)];	564	newpad = PadlistARRAY (padlist)[off];
535	--AvFILLp (padlist);	565	PadlistMAX (padlist) = off - 1;
536		566
537	av_store (newpadlist, 0, SvREFCNT_inc_NN (AvARRAY (padlist)[0]));	567	/* Already extended to 2 elements by newPADLIST. */
538	av_store (newpadlist, 1, (SV *)newpad);	568	PadlistMAX (newpadlist) = 1;
		569	PadlistNAMES (newpadlist) = (PADNAMELIST *)SvREFCNT_inc_NN (PadlistNAMES (padlist));
		570	PadlistARRAY (newpadlist)[1] = newpad;
539		571
540	return newpadlist;	572	return newpadlist;
541	}	573	}
542		574
543	ECB_INLINE void	575	ecb_inline void
544	free_padlist (pTHX_ AV *padlist)	576	free_padlist (pTHX_ PADLIST *padlist)
545	{	577	{
546	/* may be during global destruction */	578	/* may be during global destruction */
547	if (!IN_DESTRUCT)	579	if (!IN_DESTRUCT)
548	{	580	{
549	I32 i = AvFILLp (padlist);	581	I32 i = PadlistMAX (padlist);
550		582
551	while (i > 0) /* special-case index 0 */	583	while (i > 0) /* special-case index 0 */
552	{	584	{
553	/* we try to be extra-careful here */	585	/* we try to be extra-careful here */
554	AV av = (AV )AvARRAY (padlist)[i--];	586	PAD *pad = PadlistARRAY (padlist)[i--];
555	I32 j = AvFILLp (av);	587	I32 j = PadMAX (pad);
556		588
557	while (j >= 0)	589	while (j >= 0)
558	SvREFCNT_dec (AvARRAY (av)[j--]);	590	SvREFCNT_dec (PadARRAY (pad)[j--]);
559		591
560	AvFILLp (av) = -1;	592	PadMAX (pad) = -1;
561	SvREFCNT_dec (av);	593	SvREFCNT_dec (pad);
562	}	594	}
563		595
564	SvREFCNT_dec (AvARRAY (padlist)[0]);	596	SvREFCNT_dec (PadlistNAMES (padlist));
565		597
		598	#ifdef NEWPADAPI
		599	Safefree (PadlistARRAY (padlist));
		600	Safefree (padlist);
		601	#else
566	AvFILLp (padlist) = -1;	602	AvFILLp (padlist) = -1;
		603	AvREAL_off (padlist);
567	SvREFCNT_dec ((SV*)padlist);	604	SvREFCNT_dec ((SV*)padlist);
		605	#endif
568	}	606	}
569	}	607	}
570		608
571	static int	609	static int
572	coro_cv_free (pTHX_ SV sv, MAGIC mg)	610	coro_cv_free (pTHX_ SV sv, MAGIC mg)
573	{	611	{
574	AV *padlist;	612	PADLIST *padlist;
575	AV av = (AV )mg->mg_obj;	613	PADLIST padlists = (PADLIST )(mg->mg_ptr + sizeof(size_t));
		614	size_t len = (size_t )mg->mg_ptr;
576		615
577	/* perl manages to free our internal AV and _then_ call us */	616	/* perl manages to free our internal AV and _then_ call us */
578	if (IN_DESTRUCT)	617	if (IN_DESTRUCT)
579	return 0;	618	return 0;
580		619
581	/* casting is fun. */	620	while (len--)
582	while (&PL_sv_undef != (SV )(padlist = (AV )av_pop (av)))
583	free_padlist (aTHX_ padlist);	621	free_padlist (aTHX_ padlists[len]);
584
585	SvREFCNT_dec (av); /* sv_magicext increased the refcount */
586		622
587	return 0;	623	return 0;
588	}	624	}
589		625
590	static MGVTBL coro_cv_vtbl = {	626	static MGVTBL coro_cv_vtbl = {
591	0, 0, 0, 0,	627	0, 0, 0, 0,
592	coro_cv_free	628	coro_cv_free
593	};	629	};
594		630
595	/* the next two functions merely cache the padlists */	631	/* the next two functions merely cache the padlists */
596	ECB_INLINE void	632	ecb_inline void
597	get_padlist (pTHX_ CV *cv)	633	get_padlist (pTHX_ CV *cv)
598	{	634	{
599	MAGIC *mg = CORO_MAGIC_cv (cv);	635	MAGIC *mg = CORO_MAGIC_cv (cv);
600	AV *av;	636	size_t *lenp;
601		637
602	if (ecb_expect_true (mg && AvFILLp ((av = (AV *)mg->mg_obj)) >= 0))	638	if (ecb_expect_true (mg && (lenp = (size_t )mg->mg_ptr)))
603	CvPADLIST (cv) = (AV *)AvARRAY (av)[AvFILLp (av)--];	639	CvPADLIST (cv) = ((PADLIST *)(mg->mg_ptr + sizeof(size_t)))[--lenp];
604	else	640	else
605	{	641	{
606	#if CORO_PREFER_PERL_FUNCTIONS	642	#if CORO_PREFER_PERL_FUNCTIONS
607	/* this is probably cleaner? but also slower! */	643	/* this is probably cleaner? but also slower! */
608	/* in practise, it seems to be less stable */	644	/* in practise, it seems to be less stable */
…		…
614	CvPADLIST (cv) = coro_derive_padlist (aTHX_ cv);	650	CvPADLIST (cv) = coro_derive_padlist (aTHX_ cv);
615	#endif	651	#endif
616	}	652	}
617	}	653	}
618		654
619	ECB_INLINE void	655	ecb_inline void
620	put_padlist (pTHX_ CV *cv)	656	put_padlist (pTHX_ CV *cv)
621	{	657	{
622	MAGIC *mg = CORO_MAGIC_cv (cv);	658	MAGIC *mg = CORO_MAGIC_cv (cv);
623	AV *av;
624		659
625	if (ecb_expect_false (!mg))	660	if (ecb_expect_false (!mg))
		661	{
626	mg = sv_magicext ((SV )cv, (SV )newAV (), CORO_MAGIC_type_cv, &coro_cv_vtbl, 0, 0);	662	mg = sv_magicext ((SV *)cv, 0, CORO_MAGIC_type_cv, &coro_cv_vtbl, 0, 0);
		663	Newz (0, mg->mg_ptr ,sizeof (size_t) + sizeof (PADLIST *), char);
		664	mg->mg_len = 1; /* so mg_free frees mg_ptr */
		665	}
		666	else
		667	Renew (mg->mg_ptr,
		668	sizeof(size_t) + ((size_t )mg->mg_ptr + 1) * sizeof(PADLIST *),
		669	char);
627		670
628	av = (AV *)mg->mg_obj;	671	((PADLIST *)(mg->mg_ptr + sizeof (size_t))) [((size_t *)mg->mg_ptr)++] = CvPADLIST (cv);
629
630	if (ecb_expect_false (AvFILLp (av) >= AvMAX (av)))
631	av_extend (av, AvFILLp (av) + 1);
632
633	AvARRAY (av)[++AvFILLp (av)] = (SV *)CvPADLIST (cv);
634	}	672	}
635		673
636	/ load & save, init *****************************************************/	674	/ load & save, init *****************************************************/
637		675
		676	ecb_inline void
		677	swap_sv (SV a, SV b)
		678	{
		679	const U32 keep = SVs_PADSTALE \| SVs_PADTMP \| SVs_PADMY; /* keep these flags */
		680	SV tmp;
		681
		682	/* swap sv_any */
		683	SvANY (&tmp) = SvANY (a); SvANY (a) = SvANY (b); SvANY (b) = SvANY (&tmp);
		684
		685	/* swap sv_flags */
		686	SvFLAGS (&tmp) = SvFLAGS (a);
		687	SvFLAGS (a) = (SvFLAGS (a) & keep) \| (SvFLAGS (b ) & ~keep);
		688	SvFLAGS (b) = (SvFLAGS (b) & keep) \| (SvFLAGS (&tmp) & ~keep);
		689
		690	#if PERL_VERSION_ATLEAST (5,10,0)
		691	/* perl 5.10 and later complicates this _quite_ a bit, but it also
		692	* is much faster, so no quarrels here. alternatively, we could
		693	* sv_upgrade to avoid this.
		694	*/
		695	{
		696	/* swap sv_u */
		697	tmp.sv_u = a->sv_u; a->sv_u = b->sv_u; b->sv_u = tmp.sv_u;
		698
		699	/* if SvANY points to the head, we need to adjust the pointers,
		700	* as the pointer for a still points to b, and maybe vice versa.
		701	*/
		702	#define svany_in_head(type) \
		703	(((1 << SVt_NULL) \| (1 << SVt_BIND) \| (1 << SVt_IV) \| (1 << SVt_RV)) & (1 << (type)))
		704
		705	if (svany_in_head (SvTYPE (a)))
		706	SvANY (a) = (void *)((PTRV)SvANY (a) - (PTRV)b + (PTRV)a);
		707
		708	if (svany_in_head (SvTYPE (b)))
		709	SvANY (b) = (void *)((PTRV)SvANY (b) - (PTRV)a + (PTRV)b);
		710	}
		711	#endif
		712	}
		713
638	/* swap sv heads, at least logically */	714	/* swap sv heads, at least logically */
639	static void	715	static void
640	swap_svs (pTHX_ Coro__State c)	716	swap_svs (pTHX_ Coro__State c)
641	{	717	{
642	int i;	718	int i;
643		719
644	for (i = 0; i <= AvFILLp (c->swap_sv); )	720	for (i = 0; i <= AvFILLp (c->swap_sv); i += 2)
645	{	721	swap_sv (AvARRAY (c->swap_sv)[i], AvARRAY (c->swap_sv)[i + 1]);
646	SV *a = AvARRAY (c->swap_sv)[i++];
647	SV *b = AvARRAY (c->swap_sv)[i++];
648
649	const U32 keep = SVs_PADSTALE \| SVs_PADTMP \| SVs_PADMY; /* keep these flags */
650	SV tmp;
651
652	/* swap sv_any */
653	SvANY (&tmp) = SvANY (a); SvANY (a) = SvANY (b); SvANY (b) = SvANY (&tmp);
654
655	/* swap sv_flags */
656	SvFLAGS (&tmp) = SvFLAGS (a);
657	SvFLAGS (a) = (SvFLAGS (a) & keep) \| (SvFLAGS (b ) & ~keep);
658	SvFLAGS (b) = (SvFLAGS (b) & keep) \| (SvFLAGS (&tmp) & ~keep);
659
660	#if PERL_VERSION_ATLEAST (5,10,0)
661	/* perl 5.10 complicates this _quite_ a bit, but it also is
662	* much faster, so no quarrels here. alternatively, we could
663	* sv_upgrade to avoid this.
664	*/
665	{
666	/* swap sv_u */
667	tmp.sv_u = a->sv_u; a->sv_u = b->sv_u; b->sv_u = tmp.sv_u;
668
669	/* if SvANY points to the head, we need to adjust the pointers,
670	* as the pointer for a still points to b, and maybe vice versa.
671	*/
672	#define svany_in_head(type) \
673	(((1 << SVt_NULL) \| (1 << SVt_BIND) \| (1 << SVt_IV) \| (1 << SVt_RV)) & (1 << (type)))
674
675	if (svany_in_head (SvTYPE (a)))
676	SvANY (a) = (void *)((PTRV)SvANY (a) - (PTRV)b + (PTRV)a);
677
678	if (svany_in_head (SvTYPE (b)))
679	SvANY (b) = (void *)((PTRV)SvANY (b) - (PTRV)a + (PTRV)b);
680	}
681	#endif
682	}
683	}	722	}
684		723
685	#define SWAP_SVS(coro) \	724	#define SWAP_SVS(coro) \
686	if (ecb_expect_false ((coro)->swap_sv)) \	725	if (ecb_expect_false ((coro)->swap_sv)) \
687	swap_svs (aTHX_ (coro))	726	swap_svs (aTHX_ (coro))
…		…
699		738
700	#if CORO_JIT	739	#if CORO_JIT
701	load_perl_slots (slot);	740	load_perl_slots (slot);
702	#else	741	#else
703	#define VARx(name,expr,type) expr = slot->name;	742	#define VARx(name,expr,type) expr = slot->name;
704	# include "state.h"	743	#include "state.h"
705	#undef VARx
706	#endif	744	#endif
707		745
708	{	746	{
709	dSP;	747	dSP;
710		748
…		…
713	/* now do the ugly restore mess */	751	/* now do the ugly restore mess */
714	while (ecb_expect_true (cv = (CV *)POPs))	752	while (ecb_expect_true (cv = (CV *)POPs))
715	{	753	{
716	put_padlist (aTHX_ cv); /* mark this padlist as available */	754	put_padlist (aTHX_ cv); /* mark this padlist as available */
717	CvDEPTH (cv) = PTR2IV (POPs);	755	CvDEPTH (cv) = PTR2IV (POPs);
718	CvPADLIST (cv) = (AV *)POPs;	756	CvPADLIST (cv) = (PADLIST *)POPs;
719	}	757	}
720		758
721	PUTBACK;	759	PUTBACK;
722	}	760	}
723		761
…		…
813		851
814	PUTBACK;	852	PUTBACK;
815	}	853	}
816		854
817	/* allocate some space on the context stack for our purposes */	855	/* allocate some space on the context stack for our purposes */
818	if (ecb_expect_false (cxstack_ix + SLOT_COUNT >= cxstack_max))	856	if (ecb_expect_false (cxstack_ix + (int)SLOT_COUNT >= cxstack_max))
819	{	857	{
820	unsigned int i;	858	unsigned int i;
821		859
822	for (i = 0; i < SLOT_COUNT; ++i)	860	for (i = 0; i < SLOT_COUNT; ++i)
823	CXINC;	861	CXINC;
…		…
832		870
833	#if CORO_JIT	871	#if CORO_JIT
834	save_perl_slots (slot);	872	save_perl_slots (slot);
835	#else	873	#else
836	#define VARx(name,expr,type) slot->name = expr;	874	#define VARx(name,expr,type) slot->name = expr;
837	# include "state.h"	875	#include "state.h"
838	#undef VARx
839	#endif	876	#endif
840	}	877	}
841	}	878	}
842		879
843	/*	880	/*
…		…
875	#endif	912	#endif
876		913
877	New(54,PL_scopestack,8,I32);	914	New(54,PL_scopestack,8,I32);
878	PL_scopestack_ix = 0;	915	PL_scopestack_ix = 0;
879	PL_scopestack_max = 8;	916	PL_scopestack_max = 8;
		917	#if HAS_SCOPESTACK_NAME
		918	New(54,PL_scopestack_name,8,const char*);
		919	#endif
880		920
881	New(54,PL_savestack,24,ANY);	921	New(54,PL_savestack,24,ANY);
882	PL_savestack_ix = 0;	922	PL_savestack_ix = 0;
883	PL_savestack_max = 24;	923	PL_savestack_max = 24;
884		924
…		…
912	}	952	}
913		953
914	Safefree (PL_tmps_stack);	954	Safefree (PL_tmps_stack);
915	Safefree (PL_markstack);	955	Safefree (PL_markstack);
916	Safefree (PL_scopestack);	956	Safefree (PL_scopestack);
		957	#if HAS_SCOPESTACK_NAME
		958	Safefree (PL_scopestack_name);
		959	#endif
917	Safefree (PL_savestack);	960	Safefree (PL_savestack);
918	#if !PERL_VERSION_ATLEAST (5,10,0)	961	#if !PERL_VERSION_ATLEAST (5,10,0)
919	Safefree (PL_retstack);	962	Safefree (PL_retstack);
920	#endif	963	#endif
921	}	964	}
…		…
981	{	1024	{
982	SV **svp = 0;	1025	SV **svp = 0;
983		1026
984	if (strEQ (s, "__DIE__" )) svp = &PL_diehook;	1027	if (strEQ (s, "__DIE__" )) svp = &PL_diehook;
985	if (strEQ (s, "__WARN__")) svp = &PL_warnhook;	1028	if (strEQ (s, "__WARN__")) svp = &PL_warnhook;
986		1029
987	if (svp)	1030	if (svp)
988	{	1031	{
989	sv_setsv (sv, svp ? svp : &PL_sv_undef);	1032	SV *ssv;
		1033
		1034	if (!*svp)
		1035	ssv = &PL_sv_undef;
		1036	else if (SvTYPE (svp) == SVt_PVCV) / perlio directly stores a CV in warnhook. ugh. */
		1037	ssv = sv_2mortal (newRV_inc (*svp));
		1038	else
		1039	ssv = *svp;
		1040
		1041	sv_setsv (sv, ssv);
990	return 0;	1042	return 0;
991	}	1043	}
992	}	1044	}
993		1045
994	return orig_sigelem_get ? orig_sigelem_get (aTHX_ sv, mg) : 0;	1046	return orig_sigelem_get ? orig_sigelem_get (aTHX_ sv, mg) : 0;
…		…
1088	PL_hints = 0;	1140	PL_hints = 0;
1089		1141
1090	/* recreate the die/warn hooks */	1142	/* recreate the die/warn hooks */
1091	PL_diehook = SvREFCNT_inc (rv_diehook);	1143	PL_diehook = SvREFCNT_inc (rv_diehook);
1092	PL_warnhook = SvREFCNT_inc (rv_warnhook);	1144	PL_warnhook = SvREFCNT_inc (rv_warnhook);
1093		1145
1094	GvSV (PL_defgv) = newSV (0);	1146	GvSV (PL_defgv) = newSV (0);
1095	GvAV (PL_defgv) = coro->args; coro->args = 0;	1147	GvAV (PL_defgv) = coro->args; coro->args = 0;
1096	GvSV (PL_errgv) = newSV (0);	1148	GvSV (PL_errgv) = newSV (0);
1097	GvSV (irsgv) = newSVpvn ("\n", 1); sv_magic (GvSV (irsgv), (SV *)irsgv, PERL_MAGIC_sv, "/", 0);	1149	GvSV (irsgv) = newSVpvn ("\n", 1); sv_magic (GvSV (irsgv), (SV *)irsgv, PERL_MAGIC_sv, "/", 0);
1098	GvHV (PL_hintgv) = 0;	1150	GvHV (PL_hintgv) = 0;
…		…
1186	/* restore swapped sv's */	1238	/* restore swapped sv's */
1187	SWAP_SVS (coro);	1239	SWAP_SVS (coro);
1188		1240
1189	coro_destruct_stacks (aTHX);	1241	coro_destruct_stacks (aTHX);
1190		1242
1191	// now save some sv's to be free'd later	1243	/* now save some sv's to be free'd later */
1192	svf [0] = GvSV (PL_defgv);	1244	svf [0] = GvSV (PL_defgv);
1193	svf [1] = (SV *)GvAV (PL_defgv);	1245	svf [1] = (SV *)GvAV (PL_defgv);
1194	svf [2] = GvSV (PL_errgv);	1246	svf [2] = GvSV (PL_errgv);
1195	svf [3] = (SV *)PL_defoutgv;	1247	svf [3] = (SV *)PL_defoutgv;
1196	svf [4] = PL_rs;	1248	svf [4] = PL_rs;
…		…
1216	SvREFCNT_dec (coro->invoke_cb);	1268	SvREFCNT_dec (coro->invoke_cb);
1217	SvREFCNT_dec (coro->invoke_av);	1269	SvREFCNT_dec (coro->invoke_av);
1218	}	1270	}
1219	}	1271	}
1220		1272
1221	ECB_INLINE void	1273	ecb_inline void
1222	free_coro_mortal (pTHX)	1274	free_coro_mortal (pTHX)
1223	{	1275	{
1224	if (ecb_expect_true (coro_mortal))	1276	if (ecb_expect_true (coro_mortal))
1225	{	1277	{
1226	SvREFCNT_dec ((SV *)coro_mortal);	1278	SvREFCNT_dec ((SV *)coro_mortal);
…		…
1385	slf_frame.prepare = slf_prepare_set_stacklevel;	1437	slf_frame.prepare = slf_prepare_set_stacklevel;
1386	slf_frame.check = slf_check_set_stacklevel;	1438	slf_frame.check = slf_check_set_stacklevel;
1387	}	1439	}
1388		1440
1389	/* the tail of transfer: execute stuff we can only do after a transfer */	1441	/* the tail of transfer: execute stuff we can only do after a transfer */
1390	ECB_INLINE void	1442	ecb_inline void
1391	transfer_tail (pTHX)	1443	transfer_tail (pTHX)
1392	{	1444	{
1393	free_coro_mortal (aTHX);	1445	free_coro_mortal (aTHX);
		1446	}
		1447
		1448	/* try to exit the same way perl's main function would do */
		1449	/* we do not bother resetting the environment or other things *7
		1450	/* that are not, uhm, essential */
		1451	/* this obviously also doesn't work when perl is embedded */
		1452	static void ecb_noinline ecb_cold
		1453	perlish_exit (pTHX)
		1454	{
		1455	int exitstatus = perl_destruct (PL_curinterp);
		1456	perl_free (PL_curinterp);
		1457	exit (exitstatus);
1394	}	1458	}
1395		1459
1396	/*	1460	/*
1397	* this is a _very_ stripped down perl interpreter ;)	1461	* this is a _very_ stripped down perl interpreter ;)
1398	*/	1462	*/
…		…
1427	*/	1491	*/
1428		1492
1429	/*	1493	/*
1430	* If perl-run returns we assume exit() was being called or the coro	1494	* If perl-run returns we assume exit() was being called or the coro
1431	* fell off the end, which seems to be the only valid (non-bug)	1495	* fell off the end, which seems to be the only valid (non-bug)
1432	* reason for perl_run to return. We try to exit by jumping to the	1496	* reason for perl_run to return. We try to mimic whatever perl is normally
1433	* bootstrap-time "top" top_env, as we cannot restore the "main"	1497	* doing in that case. YMMV.
1434	* coroutine as Coro has no such concept.
1435	* This actually isn't valid with the pthread backend, but OSes requiring
1436	* that backend are too broken to do it in a standards-compliant way.
1437	*/	1498	*/
1438	PL_top_env = main_top_env;	1499	perlish_exit (aTHX);
1439	JMPENV_JUMP (2); /* I do not feel well about the hardcoded 2 at all */
1440	}	1500	}
1441	}	1501	}
1442		1502
1443	static coro_cctx *	1503	static coro_cctx *
1444	cctx_new ()	1504	cctx_new (void)
1445	{	1505	{
1446	coro_cctx *cctx;	1506	coro_cctx *cctx;
1447		1507
1448	++cctx_count;	1508	++cctx_count;
1449	New (0, cctx, 1, coro_cctx);	1509	New (0, cctx, 1, coro_cctx);
…		…
1455	return cctx;	1515	return cctx;
1456	}	1516	}
1457		1517
1458	/* create a new cctx only suitable as source */	1518	/* create a new cctx only suitable as source */
1459	static coro_cctx *	1519	static coro_cctx *
1460	cctx_new_empty ()	1520	cctx_new_empty (void)
1461	{	1521	{
1462	coro_cctx *cctx = cctx_new ();	1522	coro_cctx *cctx = cctx_new ();
1463		1523
1464	cctx->sptr = 0;	1524	cctx->sptr = 0;
1465	coro_create (&cctx->cctx, 0, 0, 0, 0);	1525	coro_create (&cctx->cctx, 0, 0, 0, 0);
…		…
1467	return cctx;	1527	return cctx;
1468	}	1528	}
1469		1529
1470	/* create a new cctx suitable as destination/running a perl interpreter */	1530	/* create a new cctx suitable as destination/running a perl interpreter */
1471	static coro_cctx *	1531	static coro_cctx *
1472	cctx_new_run ()	1532	cctx_new_run (void)
1473	{	1533	{
1474	coro_cctx *cctx = cctx_new ();	1534	coro_cctx *cctx = cctx_new ();
1475	void *stack_start;	1535	void *stack_start;
1476	size_t stack_size;	1536	size_t stack_size;
1477		1537
1478	#if HAVE_MMAP	1538	#if HAVE_MMAP
1479	cctx->ssize = ((cctx_stacksize * sizeof (long) + PAGESIZE - 1) / PAGESIZE + CORO_STACKGUARD) * PAGESIZE;	1539	cctx->ssize = ((cctx_stacksize * sizeof (long) + PAGESIZE - 1) / PAGESIZE + CORO_STACKGUARD) * PAGESIZE;
1480	/* mmap supposedly does allocate-on-write for us */	1540	/* mmap supposedly does allocate-on-write for us */
1481	cctx->sptr = mmap (0, cctx->ssize, PROT_EXEC\|PROT_READ\|PROT_WRITE, MAP_PRIVATE\|MAP_ANONYMOUS, 0, 0);	1541	cctx->sptr = mmap (0, cctx->ssize, PROT_READ \| PROT_WRITE \| PROT_EXEC, MAP_ANONYMOUS, -1, 0);
1482		1542
1483	if (cctx->sptr != (void *)-1)	1543	if (cctx->sptr != (void *)-1)
1484	{	1544	{
1485	#if CORO_STACKGUARD	1545	#if CORO_STACKGUARD
1486	mprotect (cctx->sptr, CORO_STACKGUARD * PAGESIZE, PROT_NONE);	1546	mprotect (cctx->sptr, CORO_STACKGUARD * PAGESIZE, PROT_NONE);
…		…
1701	return;	1761	return;
1702		1762
1703	slf_destroy (aTHX_ coro);	1763	slf_destroy (aTHX_ coro);
1704		1764
1705	coro->flags \|= CF_ZOMBIE;	1765	coro->flags \|= CF_ZOMBIE;
1706		1766
1707	if (coro->flags & CF_READY)	1767	if (coro->flags & CF_READY)
1708	{	1768	{
1709	/* reduce nready, as destroying a ready coro effectively unreadies it */	1769	/* reduce nready, as destroying a ready coro effectively unreadies it */
1710	/* alternative: look through all ready queues and remove the coro */	1770	/* alternative: look through all ready queues and remove the coro */
1711	--coro_nready;	1771	--coro_nready;
…		…
1788	TRANSFER (ta, 1);	1848	TRANSFER (ta, 1);
1789	}	1849	}
1790		1850
1791	/ Coro ******************************************************************/	1851	/ Coro ******************************************************************/
1792		1852
1793	ECB_INLINE void	1853	ecb_inline void
1794	coro_enq (pTHX_ struct coro *coro)	1854	coro_enq (pTHX_ struct coro *coro)
1795	{	1855	{
1796	struct coro **ready = coro_ready [coro->prio - CORO_PRIO_MIN];	1856	struct coro **ready = coro_ready [coro->prio - CORO_PRIO_MIN];
1797		1857
1798	SvREFCNT_inc_NN (coro->hv);	1858	SvREFCNT_inc_NN (coro->hv);
…		…
1800	coro->next_ready = 0;	1860	coro->next_ready = 0;
1801	*(ready [0] ? &ready [1]->next_ready : &ready [0]) = coro;	1861	*(ready [0] ? &ready [1]->next_ready : &ready [0]) = coro;
1802	ready [1] = coro;	1862	ready [1] = coro;
1803	}	1863	}
1804		1864
1805	ECB_INLINE struct coro *	1865	ecb_inline struct coro *
1806	coro_deq (pTHX)	1866	coro_deq (pTHX)
1807	{	1867	{
1808	int prio;	1868	int prio;
1809		1869
1810	for (prio = CORO_PRIO_MAX - CORO_PRIO_MIN + 1; --prio >= 0; )	1870	for (prio = CORO_PRIO_MAX - CORO_PRIO_MIN + 1; --prio >= 0; )
…		…
1863	{	1923	{
1864	return !!(SvSTATE (coro_sv)->flags & CF_READY);	1924	return !!(SvSTATE (coro_sv)->flags & CF_READY);
1865	}	1925	}
1866		1926
1867	/* expects to own a reference to next->hv */	1927	/* expects to own a reference to next->hv */
1868	ECB_INLINE void	1928	ecb_inline void
1869	prepare_schedule_to (pTHX_ struct coro_transfer_args ta, struct coro next)	1929	prepare_schedule_to (pTHX_ struct coro_transfer_args ta, struct coro next)
1870	{	1930	{
1871	SV *prev_sv = SvRV (coro_current);	1931	SV *prev_sv = SvRV (coro_current);
1872		1932
1873	ta->prev = SvSTATE_hv (prev_sv);	1933	ta->prev = SvSTATE_hv (prev_sv);
…		…
1932	}	1992	}
1933	}	1993	}
1934	}	1994	}
1935	}	1995	}
1936		1996
1937	ECB_INLINE void	1997	ecb_inline void
1938	prepare_cede (pTHX_ struct coro_transfer_args *ta)	1998	prepare_cede (pTHX_ struct coro_transfer_args *ta)
1939	{	1999	{
1940	api_ready (aTHX_ coro_current);	2000	api_ready (aTHX_ coro_current);
1941	prepare_schedule (aTHX_ ta);	2001	prepare_schedule (aTHX_ ta);
1942	}	2002	}
1943		2003
1944	ECB_INLINE void	2004	ecb_inline void
1945	prepare_cede_notself (pTHX_ struct coro_transfer_args *ta)	2005	prepare_cede_notself (pTHX_ struct coro_transfer_args *ta)
1946	{	2006	{
1947	SV *prev = SvRV (coro_current);	2007	SV *prev = SvRV (coro_current);
1948		2008
1949	if (coro_nready)	2009	if (coro_nready)
…		…
2144		2204
2145	static void	2205	static void
2146	coro_set_status (pTHX_ struct coro coro, SV *arg, int items)	2206	coro_set_status (pTHX_ struct coro coro, SV *arg, int items)
2147	{	2207	{
2148	AV *av;	2208	AV *av;
2149		2209
2150	if (coro->status)	2210	if (coro->status)
2151	{	2211	{
2152	av = coro->status;	2212	av = coro->status;
2153	av_clear (av);	2213	av_clear (av);
2154	}	2214	}
…		…
2201		2261
2202	coro = SvSTATE (arg [0]);	2262	coro = SvSTATE (arg [0]);
2203	coro_hv = coro->hv;	2263	coro_hv = coro->hv;
2204		2264
2205	coro_set_status (aTHX_ coro, arg + 1, items - 1);	2265	coro_set_status (aTHX_ coro, arg + 1, items - 1);
2206		2266
2207	if (ecb_expect_false (coro->flags & CF_NOCANCEL))	2267	if (ecb_expect_false (coro->flags & CF_NOCANCEL))
2208	{	2268	{
2209	/* coro currently busy cancelling something, so just notify it */	2269	/* coro currently busy cancelling something, so just notify it */
2210	coro->slf_frame.data = (void *)coro;	2270	coro->slf_frame.data = (void *)coro;
2211		2271
…		…
2390		2450
2391	static int	2451	static int
2392	slf_check_rouse_wait (pTHX_ struct CoroSLF *frame)	2452	slf_check_rouse_wait (pTHX_ struct CoroSLF *frame)
2393	{	2453	{
2394	SV data = (SV )frame->data;	2454	SV data = (SV )frame->data;
2395		2455
2396	if (CORO_THROW)	2456	if (CORO_THROW)
2397	return 0;	2457	return 0;
2398		2458
2399	if (SvTYPE (SvRV (data)) != SVt_PVAV)	2459	if (SvTYPE (SvRV (data)) != SVt_PVAV)
2400	return 1;	2460	return 1;
…		…
2436	cb = sv_2mortal (coro->rouse_cb);	2496	cb = sv_2mortal (coro->rouse_cb);
2437	coro->rouse_cb = 0;	2497	coro->rouse_cb = 0;
2438	}	2498	}
2439		2499
2440	if (!SvROK (cb)	2500	if (!SvROK (cb)
2441	\|\| SvTYPE (SvRV (cb)) != SVt_PVCV	2501	\|\| SvTYPE (SvRV (cb)) != SVt_PVCV
2442	\|\| CvXSUB ((CV *)SvRV (cb)) != coro_rouse_callback)	2502	\|\| CvXSUB ((CV *)SvRV (cb)) != coro_rouse_callback)
2443	croak ("Coro::rouse_wait called with illegal callback argument,");	2503	croak ("Coro::rouse_wait called with illegal callback argument,");
2444		2504
2445	{	2505	{
2446	CV cv = (CV )SvRV (cb); /* for S_GENSUB_ARG */	2506	CV cv = (CV )SvRV (cb); /* for S_GENSUB_ARG */
…		…
2949	{	3009	{
2950	int i;	3010	int i;
2951	/* if we were woken up but can't down, we look through the whole */	3011	/* if we were woken up but can't down, we look through the whole */
2952	/* waiters list and only add us if we aren't in there already */	3012	/* waiters list and only add us if we aren't in there already */
2953	/* this avoids some degenerate memory usage cases */	3013	/* this avoids some degenerate memory usage cases */
2954	for (i = AvFILLp (av); i > 0; --i) // i > 0 is not an off-by-one bug	3014	for (i = AvFILLp (av); i > 0; --i) /* i > 0 is not an off-by-one bug */
2955	if (AvARRAY (av)[i] == coro_hv)	3015	if (AvARRAY (av)[i] == coro_hv)
2956	return 1;	3016	return 1;
2957		3017
2958	av_push (av, SvREFCNT_inc (coro_hv));	3018	av_push (av, SvREFCNT_inc (coro_hv));
2959	return 1;	3019	return 1;
…		…
3339	#endif	3399	#endif
3340		3400
3341	#if CORO_JIT	3401	#if CORO_JIT
3342		3402
3343	static void ecb_noinline ecb_cold	3403	static void ecb_noinline ecb_cold
3344	pushav_3uv (pTHX_ UV a, UV b, UV c)	3404	pushav_4uv (pTHX_ UV a, UV b, UV c, UV d)
3345	{	3405	{
3346	dSP;	3406	dSP;
3347	AV *av = newAV ();	3407	AV *av = newAV ();
3348		3408
		3409	av_store (av, 3, newSVuv (d));
3349	av_store (av, 2, newSVuv (c));	3410	av_store (av, 2, newSVuv (c));
3350	av_store (av, 1, newSVuv (b));	3411	av_store (av, 1, newSVuv (b));
3351	av_store (av, 0, newSVuv (a));	3412	av_store (av, 0, newSVuv (a));
3352		3413
3353	XPUSHs (sv_2mortal (newRV_noinc ((SV *)av)));	3414	XPUSHs (sv_2mortal (newRV_noinc ((SV *)av)));
…		…
3360	{	3421	{
3361	dSP;	3422	dSP;
3362	SV load, save;	3423	SV load, save;
3363	char *map_base;	3424	char *map_base;
3364	char load_ptr, save_ptr;	3425	char load_ptr, save_ptr;
3365	STRLEN load_len, save_len;	3426	STRLEN load_len, save_len, map_len;
3366	int count;	3427	int count;
3367		3428
		3429	eval_pv ("require 'Coro/jit-" CORO_JIT_TYPE ".pl'", 1);
		3430
3368	PUSHMARK (SP);	3431	PUSHMARK (SP);
3369	PUTBACK;
3370	#define VARx(name,expr,type) pushav_3uv (aTHX_ (UV)&(expr), offsetof (perl_slots, name), sizeof (type));	3432	#define VARx(name,expr,type) pushav_4uv (aTHX_ (UV)&(expr), sizeof (expr), offsetof (perl_slots, name), sizeof (type));
3371	# include "state.h"	3433	#include "state.h"
3372	#undef VARx
3373	count = call_pv ("Coro::State::_jit", G_ARRAY);	3434	count = call_pv ("Coro::State::_jit", G_ARRAY);
3374	SPAGAIN;	3435	SPAGAIN;
3375		3436
3376	save = POPs; save_ptr = SvPVbyte (save, save_len);	3437	save = POPs; save_ptr = SvPVbyte (save, save_len);
3377	load = POPs; load_ptr = SvPVbyte (load, load_len);	3438	load = POPs; load_ptr = SvPVbyte (load, load_len);
3378		3439
		3440	map_len = load_len + save_len + 16;
		3441
3379	map_base = mmap (0, load_len + save_len + 16, PROT_EXEC \| PROT_WRITE, MAP_PRIVATE \| MAP_ANONYMOUS, -1, 0);	3442	map_base = mmap (0, map_len, PROT_READ \| PROT_WRITE \| PROT_EXEC, MAP_PRIVATE \| MAP_ANONYMOUS, -1, 0);
3380		3443
3381	assert (("Coro: unable mmap jit code page, cannot continue.", map_base != (char *)MAP_FAILED));	3444	assert (("Coro: unable to mmap jit code page, cannot continue.", map_base != (char *)MAP_FAILED));
3382		3445
3383	load_perl_slots = (load_save_perl_slots_type)map_base;	3446	load_perl_slots = (load_save_perl_slots_type)map_base;
3384	memcpy (map_base, load_ptr, load_len);	3447	memcpy (map_base, load_ptr, load_len);
3385		3448
3386	map_base += (load_len + 15) & ~15;	3449	map_base += (load_len + 15) & ~15;
3387		3450
3388	save_perl_slots = (load_save_perl_slots_type)map_base;	3451	save_perl_slots = (load_save_perl_slots_type)map_base;
3389	memcpy (map_base, save_ptr, save_len);	3452	memcpy (map_base, save_ptr, save_len);
		3453
		3454	/* we are good citizens and try to make the page read-only, so the evil evil */
		3455	/* hackers might have it a bit more difficult */
		3456	mprotect (map_base, map_len, PROT_READ \| PROT_EXEC);
		3457
		3458	PUTBACK;
		3459	eval_pv ("undef &Coro::State::_jit", 1);
3390	}	3460	}
3391		3461
3392	#endif	3462	#endif
3393		3463
3394	MODULE = Coro::State PACKAGE = Coro::State PREFIX = api_	3464	MODULE = Coro::State PACKAGE = Coro::State PREFIX = api_
…		…
3462	time_init (aTHX);	3532	time_init (aTHX);
3463		3533
3464	assert (("PRIO_NORMAL must be 0", !CORO_PRIO_NORMAL));	3534	assert (("PRIO_NORMAL must be 0", !CORO_PRIO_NORMAL));
3465	#if CORO_JIT	3535	#if CORO_JIT
3466	PUTBACK;	3536	PUTBACK;
3467	require_pv ("Coro/jit-" CORO_JIT_TYPE ".pl");
3468	jit_init (aTHX);	3537	jit_init (aTHX);
3469	perl_eval_pv ("undef &Coro::State::_jit", 1);
3470	SPAGAIN;	3538	SPAGAIN;
3471	#endif	3539	#endif
3472	}	3540	}
3473		3541
3474	SV *	3542	SV *
…		…
3627	RETVAL = boolSV (coro->flags & ix);	3695	RETVAL = boolSV (coro->flags & ix);
3628	OUTPUT:	3696	OUTPUT:
3629	RETVAL	3697	RETVAL
3630		3698
3631	void	3699	void
3632	throw (Coro::State self, SV *exception = &PL_sv_undef)	3700	throw (SV self, SV exception = &PL_sv_undef)
3633	PROTOTYPE: $;$	3701	PROTOTYPE: $;$
3634	CODE:	3702	CODE:
3635	{	3703	{
		3704	struct coro *coro = SvSTATE (self);
3636	struct coro *current = SvSTATE_current;	3705	struct coro *current = SvSTATE_current;
3637	SV **exceptionp = self == current ? &CORO_THROW : &self->except;	3706	SV **exceptionp = coro == current ? &CORO_THROW : &coro->except;
3638	SvREFCNT_dec (*exceptionp);	3707	SvREFCNT_dec (*exceptionp);
3639	SvGETMAGIC (exception);	3708	SvGETMAGIC (exception);
3640	*exceptionp = SvOK (exception) ? newSVsv (exception) : 0;	3709	*exceptionp = SvOK (exception) ? newSVsv (exception) : 0;
		3710
		3711	api_ready (aTHX_ self);
3641	}	3712	}
3642		3713
3643	void	3714	void
3644	api_trace (SV *coro, int flags = CC_TRACE \| CC_TRACE_SUB)	3715	api_trace (SV *coro, int flags = CC_TRACE \| CC_TRACE_SUB)
3645	PROTOTYPE: $;$	3716	PROTOTYPE: $;$
…		…
3775		3846
3776	sv_async_pool_idle = newSVpv ("[async pool idle]", 0); SvREADONLY_on (sv_async_pool_idle);	3847	sv_async_pool_idle = newSVpv ("[async pool idle]", 0); SvREADONLY_on (sv_async_pool_idle);
3777	sv_Coro = newSVpv ("Coro", 0); SvREADONLY_on (sv_Coro);	3848	sv_Coro = newSVpv ("Coro", 0); SvREADONLY_on (sv_Coro);
3778	cv_pool_handler = get_cv ("Coro::pool_handler", GV_ADD); SvREADONLY_on (cv_pool_handler);	3849	cv_pool_handler = get_cv ("Coro::pool_handler", GV_ADD); SvREADONLY_on (cv_pool_handler);
3779	CvNODEBUG_on (get_cv ("Coro::_pool_handler", 0)); /* work around a debugger bug */	3850	CvNODEBUG_on (get_cv ("Coro::_pool_handler", 0)); /* work around a debugger bug */
3780		3851
3781	coro_stash = gv_stashpv ("Coro", TRUE);	3852	coro_stash = gv_stashpv ("Coro", TRUE);
3782		3853
3783	newCONSTSUB (coro_stash, "PRIO_MAX", newSViv (CORO_PRIO_MAX));	3854	newCONSTSUB (coro_stash, "PRIO_MAX", newSViv (CORO_PRIO_MAX));
3784	newCONSTSUB (coro_stash, "PRIO_HIGH", newSViv (CORO_PRIO_HIGH));	3855	newCONSTSUB (coro_stash, "PRIO_HIGH", newSViv (CORO_PRIO_HIGH));
3785	newCONSTSUB (coro_stash, "PRIO_NORMAL", newSViv (CORO_PRIO_NORMAL));	3856	newCONSTSUB (coro_stash, "PRIO_NORMAL", newSViv (CORO_PRIO_NORMAL));
…		…
4126	}	4197	}
4127		4198
4128	MODULE = Coro::State PACKAGE = Coro::SemaphoreSet	4199	MODULE = Coro::State PACKAGE = Coro::SemaphoreSet
4129		4200
4130	void	4201	void
4131	_may_delete (SV *sem, int count, int extra_refs)	4202	_may_delete (SV *sem, int count, unsigned int extra_refs)
4132	PPCODE:	4203	PPCODE:
4133	{	4204	{
4134	AV av = (AV )SvRV (sem);	4205	AV av = (AV )SvRV (sem);
4135		4206
4136	if (SvREFCNT ((SV *)av) == 1 + extra_refs	4207	if (SvREFCNT ((SV *)av) == 1 + extra_refs

Diff Legend

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

Comparing Coro/Coro/State.xs (file contents): Revision 1.405 by root, Sat Jun 11 13:01:26 2011 UTC vs. Revision 1.425 by root, Wed Dec 5 00:14:22 2012 UTC

Diff Legend

Comparing Coro/Coro/State.xs (file contents):
Revision 1.405 by root, Sat Jun 11 13:01:26 2011 UTC vs.
Revision 1.425 by root, Wed Dec 5 00:14:22 2012 UTC