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

Comparing Coro/Coro/State.xs (file contents):
Revision 1.121 by root, Sat Dec 2 20:40:25 2006 UTC vs.
Revision 1.135 by root, Fri Jan 5 18:25:51 2007 UTC

…		…
4	#include "perl.h"	4	#include "perl.h"
5	#include "XSUB.h"	5	#include "XSUB.h"
6		6
7	#include "patchlevel.h"	7	#include "patchlevel.h"
8		8
9	#if USE_VALGRIND
10	# include <valgrind/valgrind.h>
11	#endif
12
13	/* the maximum number of idle cctx that will be pooled */
14	#define MAX_IDLE_CCTX 8
15
16	#define PERL_VERSION_ATLEAST(a,b,c) \
17	(PERL_REVISION > (a) \
18	\|\| (PERL_REVISION == (a) \
19	&& (PERL_VERSION > (b) \
20	\|\| (PERL_VERSION == (b) && PERLSUBVERSION >= (c)))))
21
22	#if !PERL_VERSION_ATLEAST (5,6,0)
23	# ifndef PL_ppaddr
24	# define PL_ppaddr ppaddr
25	# endif
26	# ifndef call_sv
27	# define call_sv perl_call_sv
28	# endif
29	# ifndef get_sv
30	# define get_sv perl_get_sv
31	# endif
32	# ifndef get_cv
33	# define get_cv perl_get_cv
34	# endif
35	# ifndef IS_PADGV
36	# define IS_PADGV(v) 0
37	# endif
38	# ifndef IS_PADCONST
39	# define IS_PADCONST(v) 0
40	# endif
41	#endif
42
43	#include <stdio.h>	9	#include <stdio.h>
44	#include <errno.h>	10	#include <errno.h>
45		11	#include <assert.h>
46	#if !__i386 && !__x86_64 && !__powerpc && !__m68k && !__alpha && !__mips && !__sparc64
47	# undef STACKGUARD
48	#endif
49
50	#ifndef STACKGUARD
51	# define STACKGUARD 0
52	#endif
53		12
54	#ifdef HAVE_MMAP	13	#ifdef HAVE_MMAP
55	# include <unistd.h>	14	# include <unistd.h>
56	# include <sys/mman.h>	15	# include <sys/mman.h>
57	# ifndef MAP_ANONYMOUS	16	# ifndef MAP_ANONYMOUS
…		…
72	#else	31	#else
73	# define PAGESIZE 0	32	# define PAGESIZE 0
74	# define BOOT_PAGESIZE (void)0	33	# define BOOT_PAGESIZE (void)0
75	#endif	34	#endif
76		35
		36	#if USE_VALGRIND
		37	# include <valgrind/valgrind.h>
		38	#endif
		39
		40	/* the maximum number of idle cctx that will be pooled */
		41	#define MAX_IDLE_CCTX 8
		42
		43	#define PERL_VERSION_ATLEAST(a,b,c) \
		44	(PERL_REVISION > (a) \
		45	\|\| (PERL_REVISION == (a) \
		46	&& (PERL_VERSION > (b) \
		47	\|\| (PERL_VERSION == (b) && PERLSUBVERSION >= (c)))))
		48
		49	#if !PERL_VERSION_ATLEAST (5,6,0)
		50	# ifndef PL_ppaddr
		51	# define PL_ppaddr ppaddr
		52	# endif
		53	# ifndef call_sv
		54	# define call_sv perl_call_sv
		55	# endif
		56	# ifndef get_sv
		57	# define get_sv perl_get_sv
		58	# endif
		59	# ifndef get_cv
		60	# define get_cv perl_get_cv
		61	# endif
		62	# ifndef IS_PADGV
		63	# define IS_PADGV(v) 0
		64	# endif
		65	# ifndef IS_PADCONST
		66	# define IS_PADCONST(v) 0
		67	# endif
		68	#endif
		69
		70	/* 5.8.7 */
		71	#ifndef SvRV_set
		72	# define SvRV_set(s,v) SvRV(s) = (v)
		73	#endif
		74
		75	#if !__i386 && !__x86_64 && !__powerpc && !__m68k && !__alpha && !__mips && !__sparc64
		76	# undef STACKGUARD
		77	#endif
		78
		79	#ifndef STACKGUARD
		80	# define STACKGUARD 0
		81	#endif
		82
		83	/* prefer perl internal functions over our own? */
		84	#ifndef PREFER_PERL_FUNCTIONS
		85	# define PREFER_PERL_FUNCTIONS 0
		86	#endif
		87
77	/* The next macro should declare a variable stacklevel that contains and approximation	88	/* The next macro should declare a variable stacklevel that contains and approximation
78	* to the current C stack pointer. Its property is that it changes with each call	89	* to the current C stack pointer. Its property is that it changes with each call
79	* and should be unique. */	90	* and should be unique. */
80	#define dSTACKLEVEL int stacklevel	91	#define dSTACKLEVEL int stacklevel
81	#define STACKLEVEL ((void *)&stacklevel)	92	#define STACKLEVEL ((void *)&stacklevel)
82		93
83	#define IN_DESTRUCT (PL_main_cv == Nullcv)	94	#define IN_DESTRUCT (PL_main_cv == Nullcv)
84		95
85	#if __GNUC__ >= 3	96	#if __GNUC__ >= 3
86	# define attribute(x) __attribute__(x)	97	# define attribute(x) __attribute__(x)
		98	# define BARRIER __asm__ __volatile__ ("" : : : "memory")
87	#else	99	#else
88	# define attribute(x)	100	# define attribute(x)
		101	# define BARRIER
89	#endif	102	#endif
90		103
91	#define NOINLINE attribute ((noinline))	104	#define NOINLINE attribute ((noinline))
92		105
93	#include "CoroAPI.h"	106	#include "CoroAPI.h"
94
95	#define TRANSFER_SET_STACKLEVEL 0x8bfbfbfb /* magic cookie */
96		107
97	#ifdef USE_ITHREADS	108	#ifdef USE_ITHREADS
98	static perl_mutex coro_mutex;	109	static perl_mutex coro_mutex;
99	# define LOCK do { MUTEX_LOCK (&coro_mutex); } while (0)	110	# define LOCK do { MUTEX_LOCK (&coro_mutex); } while (0)
100	# define UNLOCK do { MUTEX_UNLOCK (&coro_mutex); } while (0)	111	# define UNLOCK do { MUTEX_UNLOCK (&coro_mutex); } while (0)
…		…
126	/* the stack */	137	/* the stack */
127	void *sptr;	138	void *sptr;
128	long ssize; /* positive == mmap, otherwise malloc */	139	long ssize; /* positive == mmap, otherwise malloc */
129		140
130	/* cpu state */	141	/* cpu state */
131	void idle_sp; / sp of top-level transfer/schedule/cede call */	142	void idle_sp; / sp of top-level transfer/schedule/cede call */
		143	JMPENV idle_te; / same as idle_sp, but for top_env, TODO: remove once stable */
132	JMPENV *top_env;	144	JMPENV *top_env;
133	coro_context cctx;	145	coro_context cctx;
134		146
135	int inuse;	147	int inuse;
136		148
…		…
138	int valgrind_id;	150	int valgrind_id;
139	#endif	151	#endif
140	} coro_cctx;	152	} coro_cctx;
141		153
142	enum {	154	enum {
143	CF_RUNNING = 0x0001, /* coroutine is running */	155	CF_RUNNING = 0x0001, /* coroutine is running */
144	CF_READY = 0x0002, /* coroutine is ready */	156	CF_READY = 0x0002, /* coroutine is ready */
145	CF_NEW = 0x0004, /* ahs never been switched to */	157	CF_NEW = 0x0004, /* has never been switched to */
		158	CF_DESTROYED = 0x0008, /* coroutine data has been freed */
146	};	159	};
147		160
148	/* this is a structure representing a perl-level coroutine */	161	/* this is a structure representing a perl-level coroutine */
149	struct coro {	162	struct coro {
150	/* the c coroutine allocated to this perl coroutine, if any */	163	/* the c coroutine allocated to this perl coroutine, if any */
151	coro_cctx *cctx;	164	coro_cctx *cctx;
152		165
153	/* data associated with this coroutine (initial args) */	166	/* data associated with this coroutine (initial args) */
154	AV *args;	167	AV *args;
155	int refcnt;	168	int refcnt;
156	int flags;	169	int save; /* CORO_SAVE flags */
		170	int flags; /* CF_ flags */
157		171
158	/* optionally saved, might be zero */	172	/* optionally saved, might be zero */
159	AV *defav;	173	AV defav; / @_ */
160	SV *defsv;	174	SV defsv; / $_ */
161	SV *errsv;	175	SV errsv; / $@ */
		176	SV irssv; / $/ */
		177	SV irssv_sv; / real $/ cache */
162		178
163	#define VAR(name,type) type name;	179	#define VAR(name,type) type name;
164	# include "state.h"	180	# include "state.h"
165	#undef VAR	181	#undef VAR
166		182
…		…
252		268
253	if (mg && AvFILLp ((av = (AV *)mg->mg_obj)) >= 0)	269	if (mg && AvFILLp ((av = (AV *)mg->mg_obj)) >= 0)
254	CvPADLIST (cv) = (AV *)AvARRAY (av)[AvFILLp (av)--];	270	CvPADLIST (cv) = (AV *)AvARRAY (av)[AvFILLp (av)--];
255	else	271	else
256	{	272	{
257	#if 0	273	#if PREFER_PERL_FUNCTIONS
258	/* this is probably cleaner, but also slower? */	274	/* this is probably cleaner, but also slower? */
259	CV *cp = Perl_cv_clone (cv);	275	CV *cp = Perl_cv_clone (cv);
260	CvPADLIST (cv) = CvPADLIST (cp);	276	CvPADLIST (cv) = CvPADLIST (cp);
261	CvPADLIST (cp) = 0;	277	CvPADLIST (cp) = 0;
262	SvREFCNT_dec (cp);	278	SvREFCNT_dec (cp);
…		…
289	}	305	}
290		306
291	#define SB do {	307	#define SB do {
292	#define SE } while (0)	308	#define SE } while (0)
293		309
294	#define LOAD(state) load_state ((state))
295	#define SAVE(state,flags) save_state ((state),(flags))
296
297	#define REPLACE_SV(sv,val) SB SvREFCNT_dec (sv); (sv) = (val); (val) = 0; SE	310	#define REPLACE_SV(sv,val) SB SvREFCNT_dec (sv); (sv) = (val); (val) = 0; SE
298		311
299	static void	312	static void
300	load_state (Coro__State c)	313	load_perl (Coro__State c)
301	{	314	{
302	#define VAR(name,type) PL_ ## name = c->name;	315	#define VAR(name,type) PL_ ## name = c->name;
303	# include "state.h"	316	# include "state.h"
304	#undef VAR	317	#undef VAR
305		318
306	if (c->defav) REPLACE_SV (GvAV (PL_defgv), c->defav);	319	if (c->defav) REPLACE_SV (GvAV (PL_defgv), c->defav);
307	if (c->defsv) REPLACE_SV (DEFSV , c->defsv);	320	if (c->defsv) REPLACE_SV (DEFSV , c->defsv);
308	if (c->errsv) REPLACE_SV (ERRSV , c->errsv);	321	if (c->errsv) REPLACE_SV (ERRSV , c->errsv);
		322	if (c->irssv)
		323	{
		324	if (c->irssv == PL_rs \|\| sv_eq (PL_rs, c->irssv))
		325	SvREFCNT_dec (c->irssv);
		326	else
		327	{
		328	REPLACE_SV (PL_rs, c->irssv);
		329	if (!c->irssv_sv) c->irssv_sv = get_sv ("/", 0);
		330	sv_setsv (c->irssv_sv, PL_rs);
		331	}
		332	}
309		333
310	{	334	{
311	dSP;	335	dSP;
312	CV *cv;	336	CV *cv;
313		337
…		…
322	PUTBACK;	346	PUTBACK;
323	}	347	}
324	}	348	}
325		349
326	static void	350	static void
327	save_state (Coro__State c, int flags)	351	save_perl (Coro__State c)
328	{	352	{
329	{	353	{
330	dSP;	354	dSP;
331	I32 cxix = cxstack_ix;	355	I32 cxix = cxstack_ix;
332	PERL_CONTEXT *ccstk = cxstack;	356	PERL_CONTEXT *ccstk = cxstack;
…		…
335	/*	359	/*
336	* the worst thing you can imagine happens first - we have to save	360	* the worst thing you can imagine happens first - we have to save
337	* (and reinitialize) all cv's in the whole callchain :(	361	* (and reinitialize) all cv's in the whole callchain :(
338	*/	362	*/
339		363
		364	EXTEND (SP, 3 + 1);
340	PUSHs (Nullsv);	365	PUSHs (Nullsv);
341	/* this loop was inspired by pp_caller */	366	/* this loop was inspired by pp_caller */
342	for (;;)	367	for (;;)
343	{	368	{
344	while (cxix >= 0)	369	while (cxix >= 0)
…		…
350	CV *cv = cx->blk_sub.cv;	375	CV *cv = cx->blk_sub.cv;
351		376
352	if (CvDEPTH (cv))	377	if (CvDEPTH (cv))
353	{	378	{
354	EXTEND (SP, 3);	379	EXTEND (SP, 3);
355
356	PUSHs ((SV *)CvPADLIST (cv));	380	PUSHs ((SV *)CvPADLIST (cv));
357	PUSHs (INT2PTR (SV *, CvDEPTH (cv)));	381	PUSHs (INT2PTR (SV *, CvDEPTH (cv)));
358	PUSHs ((SV *)cv);	382	PUSHs ((SV *)cv);
359		383
360	CvDEPTH (cv) = 0;	384	CvDEPTH (cv) = 0;
361	get_padlist (cv);	385	get_padlist (cv);
362	}	386	}
363	}	387	}
364	#ifdef CXt_FORMAT
365	else if (CxTYPE (cx) == CXt_FORMAT)
366	{
367	/* I never used formats, so how should I know how these are implemented? */
368	/* my bold guess is as a simple, plain sub... */
369	croak ("CXt_FORMAT not yet handled. Don't switch coroutines from within formats");
370	}
371	#endif
372	}	388	}
373		389
374	if (top_si->si_type == PERLSI_MAIN)	390	if (top_si->si_type == PERLSI_MAIN)
375	break;	391	break;
376		392
…		…
380	}	396	}
381		397
382	PUTBACK;	398	PUTBACK;
383	}	399	}
384		400
385	c->defav = flags & TRANSFER_SAVE_DEFAV ? (AV *)SvREFCNT_inc (GvAV (PL_defgv)) : 0;	401	c->defav = c->save & CORO_SAVE_DEFAV ? (AV *)SvREFCNT_inc (GvAV (PL_defgv)) : 0;
386	c->defsv = flags & TRANSFER_SAVE_DEFSV ? SvREFCNT_inc (DEFSV) : 0;	402	c->defsv = c->save & CORO_SAVE_DEFSV ? SvREFCNT_inc (DEFSV) : 0;
387	c->errsv = flags & TRANSFER_SAVE_ERRSV ? SvREFCNT_inc (ERRSV) : 0;	403	c->errsv = c->save & CORO_SAVE_ERRSV ? SvREFCNT_inc (ERRSV) : 0;
		404	c->irssv = c->save & CORO_SAVE_IRSSV ? SvREFCNT_inc (PL_rs) : 0;
388		405
389	#define VAR(name,type)c->name = PL_ ## name;	406	#define VAR(name,type)c->name = PL_ ## name;
390	# include "state.h"	407	# include "state.h"
391	#undef VAR	408	#undef VAR
392	}	409	}
…		…
395	* allocate various perl stacks. This is an exact copy	412	* allocate various perl stacks. This is an exact copy
396	* of perl.c:init_stacks, except that it uses less memory	413	* of perl.c:init_stacks, except that it uses less memory
397	* on the (sometimes correct) assumption that coroutines do	414	* on the (sometimes correct) assumption that coroutines do
398	* not usually need a lot of stackspace.	415	* not usually need a lot of stackspace.
399	*/	416	*/
		417	#if PREFER_PERL_FUNCTIONS
		418	# define coro_init_stacks init_stacks
		419	#else
400	static void	420	static void
401	coro_init_stacks ()	421	coro_init_stacks ()
402	{	422	{
403	PL_curstackinfo = new_stackinfo(128, 1024/sizeof(PERL_CONTEXT));	423	PL_curstackinfo = new_stackinfo(128, 1024/sizeof(PERL_CONTEXT));
404	PL_curstackinfo->si_type = PERLSI_MAIN;	424	PL_curstackinfo->si_type = PERLSI_MAIN;
…		…
434	New(54,PL_retstack,16,OP*);	454	New(54,PL_retstack,16,OP*);
435	PL_retstack_ix = 0;	455	PL_retstack_ix = 0;
436	PL_retstack_max = 16;	456	PL_retstack_max = 16;
437	#endif	457	#endif
438	}	458	}
		459	#endif
439		460
440	/*	461	/*
441	* destroy the stacks, the callchain etc...	462	* destroy the stacks, the callchain etc...
442	*/	463	*/
443	static void	464	static void
444	coro_destroy_stacks ()	465	coro_destroy_stacks ()
445	{	466	{
446	if (!IN_DESTRUCT)	467	if (!IN_DESTRUCT)
447	{	468	{
448	/* is this ugly, I ask? */	469	/* restore all saved variables and stuff */
449	LEAVE_SCOPE (0);	470	LEAVE_SCOPE (0);
		471	assert (PL_tmps_floor == -1);
450		472
451	/* sure it is, but more important: is it correct?? :/ */	473	/* free all temporaries */
452	FREETMPS;	474	FREETMPS;
		475	assert (PL_tmps_ix == -1);
453		476
		477	/* unwind all extra stacks */
454	/POPSTACK_TO (PL_mainstack);//D//use/	478	POPSTACK_TO (PL_mainstack);
		479
		480	/* unwind main stack */
		481	dounwind (-1);
455	}	482	}
456		483
457	while (PL_curstackinfo->si_next)	484	while (PL_curstackinfo->si_next)
458	PL_curstackinfo = PL_curstackinfo->si_next;	485	PL_curstackinfo = PL_curstackinfo->si_next;
459		486
460	while (PL_curstackinfo)	487	while (PL_curstackinfo)
461	{	488	{
462	PERL_SI *p = PL_curstackinfo->si_prev;	489	PERL_SI *p = PL_curstackinfo->si_prev;
463		490
464	{ /D//remove/
465	dSP;
466	SWITCHSTACK (PL_curstack, PL_curstackinfo->si_stack);
467	PUTBACK; /* possibly superfluous */
468	}
469
470	if (!IN_DESTRUCT)	491	if (!IN_DESTRUCT)
471	{
472	dounwind (-1);/D//remove/
473	SvREFCNT_dec (PL_curstackinfo->si_stack);	492	SvREFCNT_dec (PL_curstackinfo->si_stack);
474	}
475		493
476	Safefree (PL_curstackinfo->si_cxstack);	494	Safefree (PL_curstackinfo->si_cxstack);
477	Safefree (PL_curstackinfo);	495	Safefree (PL_curstackinfo);
478	PL_curstackinfo = p;	496	PL_curstackinfo = p;
479	}	497	}
…		…
583	{	601	{
584	coro_cctx *cctx;	602	coro_cctx *cctx;
585		603
586	++cctx_count;	604	++cctx_count;
587		605
588	New (0, cctx, 1, coro_cctx);	606	Newz (0, cctx, 1, coro_cctx);
589		607
590	#if HAVE_MMAP	608	#if HAVE_MMAP
591		609
592	cctx->ssize = ((STACKSIZE * sizeof (long) + PAGESIZE - 1) / PAGESIZE + STACKGUARD) * PAGESIZE;	610	cctx->ssize = ((STACKSIZE * sizeof (long) + PAGESIZE - 1) / PAGESIZE + STACKGUARD) * PAGESIZE;
593	/* mmap supposedly does allocate-on-write for us */	611	/* mmap supposedly does allocate-on-write for us */
…		…
688	cctx_first = cctx;	706	cctx_first = cctx;
689	}	707	}
690		708
691	/* never call directly, always through the coro_state_transfer global variable */	709	/* never call directly, always through the coro_state_transfer global variable */
692	static void NOINLINE	710	static void NOINLINE
693	transfer (struct coro prev, struct coro next, int flags)	711	transfer (struct coro prev, struct coro next)
694	{	712	{
695	dSTACKLEVEL;	713	dSTACKLEVEL;
696		714
697	/* sometimes transfer is only called to set idle_sp */	715	/* sometimes transfer is only called to set idle_sp */
698	if (flags == TRANSFER_SET_STACKLEVEL)	716	if (!next)
		717	{
699	((coro_cctx *)prev)->idle_sp = STACKLEVEL;	718	((coro_cctx *)prev)->idle_sp = STACKLEVEL;
		719	assert (((coro_cctx )prev)->idle_te = PL_top_env); / just for the side-effect when asserts are enabled */
		720	}
700	else if (prev != next)	721	else if (prev != next)
701	{	722	{
702	coro_cctx *prev__cctx;	723	coro_cctx *prev__cctx;
703		724
704	if (prev->flags & CF_NEW)	725	if (prev->flags & CF_NEW)
…		…
715	croak ("Coro::State::transfer called with non-running prev Coro::State, but can only transfer from running states");	736	croak ("Coro::State::transfer called with non-running prev Coro::State, but can only transfer from running states");
716		737
717	if (next->flags & CF_RUNNING)	738	if (next->flags & CF_RUNNING)
718	croak ("Coro::State::transfer called with running next Coro::State, but can only transfer to inactive states");	739	croak ("Coro::State::transfer called with running next Coro::State, but can only transfer to inactive states");
719		740
		741	if (next->flags & CF_DESTROYED)
		742	croak ("Coro::State::transfer called with destroyed next Coro::State, but can only transfer to inactive states");
		743
720	prev->flags &= ~CF_RUNNING;	744	prev->flags &= ~CF_RUNNING;
721	next->flags \|= CF_RUNNING;	745	next->flags \|= CF_RUNNING;
722		746
723	LOCK;	747	LOCK;
724		748
725	if (next->flags & CF_NEW)	749	if (next->flags & CF_NEW)
726	{	750	{
727	/* need to start coroutine */	751	/* need to start coroutine */
728	next->flags &= ~CF_NEW;	752	next->flags &= ~CF_NEW;
729	/* first get rid of the old state */	753	/* first get rid of the old state */
730	SAVE (prev, -1);	754	save_perl (prev);
731	/* setup coroutine call */	755	/* setup coroutine call */
732	setup_coro (next);	756	setup_coro (next);
733	/* need a new stack */	757	/* need a new stack */
734	assert (!next->stack);	758	assert (!next->cctx);
735	}	759	}
736	else	760	else
737	{	761	{
738	/* coroutine already started */	762	/* coroutine already started */
739	SAVE (prev, flags);	763	save_perl (prev);
740	LOAD (next);	764	load_perl (next);
741	}	765	}
742		766
743	prev__cctx = prev->cctx;	767	prev__cctx = prev->cctx;
744		768
745	/* possibly "free" the cctx */	769	/* possibly "free" the cctx */
746	if (prev__cctx->idle_sp == STACKLEVEL)	770	if (prev__cctx->idle_sp == STACKLEVEL)
747	{	771	{
748	/* I assume that STACKLEVEL is a stronger indicator than PL_top_env changes */	772	/* I assume that STACKLEVEL is a stronger indicator than PL_top_env changes */
749	assert (PL_top_env == prev__cctx->top_env);	773	assert (("ERROR: current top_env must equal previous top_env", PL_top_env == prev__cctx->idle_te));
750		774
751	prev->cctx = 0;	775	prev->cctx = 0;
752		776
753	cctx_put (prev__cctx);	777	cctx_put (prev__cctx);
754	prev__cctx->inuse = 0;	778	prev__cctx->inuse = 0;
…		…
767	PL_top_env = next->cctx->top_env;	791	PL_top_env = next->cctx->top_env;
768	coro_transfer (&prev__cctx->cctx, &next->cctx->cctx);	792	coro_transfer (&prev__cctx->cctx, &next->cctx->cctx);
769	}	793	}
770		794
771	free_coro_mortal ();	795	free_coro_mortal ();
772
773	UNLOCK;	796	UNLOCK;
774	}	797	}
775	}	798	}
776		799
777	struct transfer_args	800	struct transfer_args
778	{	801	{
779	struct coro prev, next;	802	struct coro prev, next;
780	int flags;
781	};	803	};
782		804
783	#define TRANSFER(ta) transfer ((ta).prev, (ta).next, (ta).flags)	805	#define TRANSFER(ta) transfer ((ta).prev, (ta).next)
784		806
785	static void	807	static int
786	coro_state_destroy (struct coro *coro)	808	coro_state_destroy (struct coro *coro)
787	{	809	{
788	if (coro->refcnt--)	810	if (coro->flags & CF_DESTROYED)
789	return;	811	return 0;
		812
		813	coro->flags \|= CF_DESTROYED;
790		814
791	if (coro->mainstack && coro->mainstack != main_mainstack)	815	if (coro->mainstack && coro->mainstack != main_mainstack)
792	{	816	{
		817	assert (!(coro->flags & CF_RUNNING));
		818
793	struct coro temp;	819	struct coro temp;
		820	Zero (&temp, 1, struct coro);
		821	temp.save = CORO_SAVE_ALL;
794		822
795	if (coro->flags & CF_RUNNING)	823	if (coro->flags & CF_RUNNING)
796	croak ("FATAL: tried to destroy currently running coroutine");	824	croak ("FATAL: tried to destroy currently running coroutine");
797		825
798	SAVE ((&temp), TRANSFER_SAVE_ALL);	826	save_perl (&temp);
799	LOAD (coro);	827	load_perl (coro);
800		828
801	coro_destroy_stacks ();	829	coro_destroy_stacks ();
802		830
803	LOAD ((&temp)); /* this will get rid of defsv etc.. */	831	load_perl (&temp); /* this will get rid of defsv etc.. */
804		832
805	coro->mainstack = 0;	833	coro->mainstack = 0;
806	}	834	}
807		835
808	cctx_destroy (coro->cctx);	836	cctx_destroy (coro->cctx);
809	SvREFCNT_dec (coro->args);	837	SvREFCNT_dec (coro->args);
810	Safefree (coro);	838
		839	return 1;
811	}	840	}
812		841
813	static int	842	static int
814	coro_state_clear (pTHX_ SV sv, MAGIC mg)	843	coro_state_free (pTHX_ SV sv, MAGIC mg)
815	{	844	{
816	struct coro coro = (struct coro )mg->mg_ptr;	845	struct coro coro = (struct coro )mg->mg_ptr;
817	mg->mg_ptr = 0;	846	mg->mg_ptr = 0;
818		847
		848	if (--coro->refcnt < 0)
		849	{
819	coro_state_destroy (coro);	850	coro_state_destroy (coro);
		851	Safefree (coro);
		852	}
820		853
821	return 0;	854	return 0;
822	}	855	}
823		856
824	static int	857	static int
…		…
831	return 0;	864	return 0;
832	}	865	}
833		866
834	static MGVTBL coro_state_vtbl = {	867	static MGVTBL coro_state_vtbl = {
835	0, 0, 0, 0,	868	0, 0, 0, 0,
836	coro_state_clear,	869	coro_state_free,
837	0,	870	0,
838	#ifdef MGf_DUP	871	#ifdef MGf_DUP
839	coro_state_dup,	872	coro_state_dup,
840	#else	873	#else
841	# define MGf_DUP 0	874	# define MGf_DUP 0
…		…
863	assert (mg->mg_type == PERL_MAGIC_ext);	896	assert (mg->mg_type == PERL_MAGIC_ext);
864	return (struct coro *)mg->mg_ptr;	897	return (struct coro *)mg->mg_ptr;
865	}	898	}
866		899
867	static void	900	static void
868	prepare_transfer (struct transfer_args ta, SV prev, SV *next, int flags)	901	prepare_transfer (struct transfer_args ta, SV prev_sv, SV *next_sv)
869	{	902	{
870	ta->prev = SvSTATE (prev);	903	ta->prev = SvSTATE (prev_sv);
871	ta->next = SvSTATE (next);	904	ta->next = SvSTATE (next_sv);
872	ta->flags = flags;
873	}	905	}
874		906
875	static void	907	static void
876	api_transfer (SV prev, SV next, int flags)	908	api_transfer (SV prev_sv, SV next_sv)
877	{	909	{
878	struct transfer_args ta;	910	struct transfer_args ta;
879		911
880	prepare_transfer (&ta, prev, next, flags);	912	prepare_transfer (&ta, prev_sv, next_sv);
881	TRANSFER (ta);	913	TRANSFER (ta);
		914	}
		915
		916	static int
		917	api_save (SV *coro_sv, int new_save)
		918	{
		919	struct coro *coro = SvSTATE (coro_sv);
		920	int old_save = coro->save;
		921
		922	if (new_save >= 0)
		923	coro->save = new_save;
		924
		925	return old_save;
882	}	926	}
883		927
884	/ Coro ******************************************************************/	928	/ Coro ******************************************************************/
885		929
886	#define PRIO_MAX 3	930	#define PRIO_MAX 3
…		…
932	coro = SvSTATE (coro_sv);	976	coro = SvSTATE (coro_sv);
933		977
934	if (coro->flags & CF_READY)	978	if (coro->flags & CF_READY)
935	return 0;	979	return 0;
936		980
937	#if 0 /* this is actually harmless */
938	if (coro->flags & CF_RUNNING)
939	croak ("Coro::ready called on currently running coroutine");
940	#endif
941
942	coro->flags \|= CF_READY;	981	coro->flags \|= CF_READY;
943		982
944	LOCK;	983	LOCK;
945	coro_enq (SvREFCNT_inc (coro_sv));	984	coro_enq (SvREFCNT_inc (coro_sv));
946	UNLOCK;	985	UNLOCK;
…		…
949	}	988	}
950		989
951	static int	990	static int
952	api_is_ready (SV *coro_sv)	991	api_is_ready (SV *coro_sv)
953	{	992	{
954	return !!SvSTATE (coro_sv)->flags & CF_READY;	993	return !!(SvSTATE (coro_sv)->flags & CF_READY);
955	}	994	}
956		995
957	static void	996	static void
958	prepare_schedule (struct transfer_args *ta)	997	prepare_schedule (struct transfer_args *ta)
959	{	998	{
960	SV prev, next;	999	SV prev_sv, next_sv;
961		1000
962	for (;;)	1001	for (;;)
963	{	1002	{
964	LOCK;	1003	LOCK;
965	next = coro_deq (PRIO_MIN);	1004	next_sv = coro_deq (PRIO_MIN);
966	UNLOCK;	1005	UNLOCK;
967		1006
		1007	/* nothing to schedule: call the idle handler */
968	if (next)	1008	if (!next_sv)
969	break;
970
971	{	1009	{
972	dSP;	1010	dSP;
973		1011
974	ENTER;	1012	ENTER;
975	SAVETMPS;	1013	SAVETMPS;
976		1014
977	PUSHMARK (SP);	1015	PUSHMARK (SP);
978	PUTBACK;	1016	PUTBACK;
979	call_sv (get_sv ("Coro::idle", FALSE), G_DISCARD);	1017	call_sv (get_sv ("Coro::idle", FALSE), G_DISCARD);
980		1018
981	FREETMPS;	1019	FREETMPS;
982	LEAVE;	1020	LEAVE;
		1021	continue;
983	}	1022	}
984	}
985		1023
986	prev = SvRV (coro_current);	1024	ta->next = SvSTATE (next_sv);
987	SvRV_set (coro_current, next);	1025
		1026	/* cannot transfer to destroyed coros, skip and look for next */
		1027	if (ta->next->flags & CF_DESTROYED)
		1028	{
		1029	SvREFCNT_dec (next_sv);
		1030	continue;
		1031	}
		1032
		1033	break;
		1034	}
988		1035
989	/* free this only after the transfer */	1036	/* free this only after the transfer */
		1037	prev_sv = SvRV (coro_current);
		1038	SvRV_set (coro_current, next_sv);
		1039	ta->prev = SvSTATE (prev_sv);
		1040
		1041	assert (ta->next->flags & CF_READY);
		1042	ta->next->flags &= ~CF_READY;
		1043
990	LOCK;	1044	LOCK;
991	free_coro_mortal ();	1045	free_coro_mortal ();
		1046	coro_mortal = prev_sv;
992	UNLOCK;	1047	UNLOCK;
993	coro_mortal = prev;
994
995	assert (!SvROK(prev));//D
996	assert (!SvROK(next));//D
997
998	ta->prev = SvSTATE (prev);
999	ta->next = SvSTATE (next);
1000	ta->flags = TRANSFER_SAVE_ALL;
1001
1002	assert (ta->flags & CF_READY);
1003	ta->next->flags &= ~CF_READY;
1004	}	1048	}
1005		1049
1006	static void	1050	static void
1007	prepare_cede (struct transfer_args *ta)	1051	prepare_cede (struct transfer_args *ta)
1008	{	1052	{
1009	api_ready (coro_current);	1053	api_ready (coro_current);
1010
1011	prepare_schedule (ta);	1054	prepare_schedule (ta);
		1055	}
		1056
		1057	static int
		1058	prepare_cede_notself (struct transfer_args *ta)
		1059	{
		1060	if (coro_nready)
		1061	{
		1062	SV *prev = SvRV (coro_current);
		1063	prepare_schedule (ta);
		1064	api_ready (prev);
		1065	return 1;
		1066	}
		1067	else
		1068	return 0;
1012	}	1069	}
1013		1070
1014	static void	1071	static void
1015	api_schedule (void)	1072	api_schedule (void)
1016	{	1073	{
…		…
1018		1075
1019	prepare_schedule (&ta);	1076	prepare_schedule (&ta);
1020	TRANSFER (ta);	1077	TRANSFER (ta);
1021	}	1078	}
1022		1079
1023	static void	1080	static int
1024	api_cede (void)	1081	api_cede (void)
1025	{	1082	{
1026	struct transfer_args ta;	1083	struct transfer_args ta;
1027		1084
1028	prepare_cede (&ta);	1085	prepare_cede (&ta);
		1086
		1087	if (ta.prev != ta.next)
		1088	{
1029	TRANSFER (ta);	1089	TRANSFER (ta);
		1090	return 1;
		1091	}
		1092	else
		1093	return 0;
		1094	}
		1095
		1096	static int
		1097	api_cede_notself (void)
		1098	{
		1099	struct transfer_args ta;
		1100
		1101	if (prepare_cede_notself (&ta))
		1102	{
		1103	TRANSFER (ta);
		1104	return 1;
		1105	}
		1106	else
		1107	return 0;
1030	}	1108	}
1031		1109
1032	MODULE = Coro::State PACKAGE = Coro::State	1110	MODULE = Coro::State PACKAGE = Coro::State
1033		1111
1034	PROTOTYPES: DISABLE	1112	PROTOTYPES: DISABLE
…		…
1040	#endif	1118	#endif
1041	BOOT_PAGESIZE;	1119	BOOT_PAGESIZE;
1042		1120
1043	coro_state_stash = gv_stashpv ("Coro::State", TRUE);	1121	coro_state_stash = gv_stashpv ("Coro::State", TRUE);
1044		1122
1045	newCONSTSUB (coro_state_stash, "SAVE_DEFAV", newSViv (TRANSFER_SAVE_DEFAV));	1123	newCONSTSUB (coro_state_stash, "SAVE_DEFAV", newSViv (CORO_SAVE_DEFAV));
1046	newCONSTSUB (coro_state_stash, "SAVE_DEFSV", newSViv (TRANSFER_SAVE_DEFSV));	1124	newCONSTSUB (coro_state_stash, "SAVE_DEFSV", newSViv (CORO_SAVE_DEFSV));
1047	newCONSTSUB (coro_state_stash, "SAVE_ERRSV", newSViv (TRANSFER_SAVE_ERRSV));	1125	newCONSTSUB (coro_state_stash, "SAVE_ERRSV", newSViv (CORO_SAVE_ERRSV));
		1126	newCONSTSUB (coro_state_stash, "SAVE_IRSSV", newSViv (CORO_SAVE_IRSSV));
		1127	newCONSTSUB (coro_state_stash, "SAVE_ALL", newSViv (CORO_SAVE_ALL));
1048		1128
1049	main_mainstack = PL_mainstack;	1129	main_mainstack = PL_mainstack;
1050		1130
1051	coroapi.ver = CORO_API_VERSION;	1131	coroapi.ver = CORO_API_VERSION;
1052	coroapi.transfer = api_transfer;	1132	coroapi.transfer = api_transfer;
…		…
1062	HV *hv;	1142	HV *hv;
1063	int i;	1143	int i;
1064		1144
1065	Newz (0, coro, 1, struct coro);	1145	Newz (0, coro, 1, struct coro);
1066	coro->args = newAV ();	1146	coro->args = newAV ();
		1147	coro->save = CORO_SAVE_ALL;
1067	coro->flags = CF_NEW;	1148	coro->flags = CF_NEW;
1068		1149
1069	hv = newHV ();	1150	hv = newHV ();
1070	sv_magicext ((SV )hv, 0, PERL_MAGIC_ext, &coro_state_vtbl, (char )coro, 0)->mg_flags \|= MGf_DUP;	1151	sv_magicext ((SV )hv, 0, PERL_MAGIC_ext, &coro_state_vtbl, (char )coro, 0)->mg_flags \|= MGf_DUP;
1071	RETVAL = sv_bless (newRV_noinc ((SV *)hv), gv_stashpv (klass, 1));	1152	RETVAL = sv_bless (newRV_noinc ((SV *)hv), gv_stashpv (klass, 1));
1072		1153
1073	for (i = 1; i < items; i++)	1154	for (i = 1; i < items; i++)
1074	av_push (coro->args, newSVsv (ST (i)));	1155	av_push (coro->args, newSVsv (ST (i)));
1075	}	1156	}
1076	OUTPUT:	1157	OUTPUT:
		1158	RETVAL
		1159
		1160	int
		1161	save (SV *coro, int new_save = -1)
		1162	CODE:
		1163	RETVAL = api_save (coro, new_save);
		1164	OUTPUT:
1077	RETVAL	1165	RETVAL
1078		1166
1079	void	1167	void
1080	_set_stacklevel (...)	1168	_set_stacklevel (...)
1081	ALIAS:	1169	ALIAS:
1082	Coro::State::transfer = 1	1170	Coro::State::transfer = 1
1083	Coro::schedule = 2	1171	Coro::schedule = 2
1084	Coro::cede = 3	1172	Coro::cede = 3
		1173	Coro::cede_notself = 4
1085	CODE:	1174	CODE:
1086	{	1175	{
1087	struct transfer_args ta;	1176	struct transfer_args ta;
1088		1177
1089	switch (ix)	1178	switch (ix)
1090	{	1179	{
1091	case 0:	1180	case 0:
1092	ta.prev = (struct coro )INT2PTR (coro_cctx , SvIV (ST (0)));	1181	ta.prev = (struct coro )INT2PTR (coro_cctx , SvIV (ST (0)));
1093	ta.next = 0;	1182	ta.next = 0;
1094	ta.flags = TRANSFER_SET_STACKLEVEL;
1095	break;	1183	break;
1096		1184
1097	case 1:	1185	case 1:
1098	if (items != 3)	1186	if (items != 2)
1099	croak ("Coro::State::transfer (prev,next,flags) expects three arguments, not %d", items);	1187	croak ("Coro::State::transfer (prev,next) expects two arguments, not %d", items);
1100		1188
1101	prepare_transfer (&ta, ST (0), ST (1), SvIV (ST (2)));	1189	prepare_transfer (&ta, ST (0), ST (1));
1102	break;	1190	break;
1103		1191
1104	case 2:	1192	case 2:
1105	prepare_schedule (&ta);	1193	prepare_schedule (&ta);
1106	break;	1194	break;
1107		1195
1108	case 3:	1196	case 3:
1109	prepare_cede (&ta);	1197	prepare_cede (&ta);
1110	break;	1198	break;
		1199
		1200	case 4:
		1201	if (!prepare_cede_notself (&ta))
		1202	XSRETURN_EMPTY;
		1203
		1204	break;
1111	}	1205	}
1112		1206
		1207	BARRIER;
1113	TRANSFER (ta);	1208	TRANSFER (ta);
1114	}
1115		1209
1116	void	1210	if (GIMME_V != G_VOID && ta.next != ta.prev)
1117	_clone_state_from (SV dst, SV src)	1211	XSRETURN_YES;
		1212	}
		1213
		1214	bool
		1215	_destroy (SV *coro_sv)
1118	CODE:	1216	CODE:
1119	{	1217	RETVAL = coro_state_destroy (SvSTATE (coro_sv));
1120	struct coro *coro_src = SvSTATE (src);	1218	OUTPUT:
1121		1219	RETVAL
1122	sv_unmagic (SvRV (dst), PERL_MAGIC_ext);
1123
1124	++coro_src->refcnt;
1125	sv_magicext (SvRV (dst), 0, PERL_MAGIC_ext, &coro_state_vtbl, (char *)coro_src, 0)->mg_flags \|= MGf_DUP;
1126	}
1127		1220
1128	void	1221	void
1129	_exit (code)	1222	_exit (code)
1130	int code	1223	int code
1131	PROTOTYPE: $	1224	PROTOTYPE: $
…		…
1168	coro_ready[i] = newAV ();	1261	coro_ready[i] = newAV ();
1169		1262
1170	{	1263	{
1171	SV *sv = perl_get_sv("Coro::API", 1);	1264	SV *sv = perl_get_sv("Coro::API", 1);
1172		1265
1173	coroapi.schedule = api_schedule;	1266	coroapi.schedule = api_schedule;
		1267	coroapi.save = api_save;
1174	coroapi.cede = api_cede;	1268	coroapi.cede = api_cede;
		1269	coroapi.cede_notself = api_cede_notself;
1175	coroapi.ready = api_ready;	1270	coroapi.ready = api_ready;
1176	coroapi.is_ready = api_is_ready;	1271	coroapi.is_ready = api_is_ready;
1177	coroapi.nready = &coro_nready;	1272	coroapi.nready = &coro_nready;
1178	coroapi.current = coro_current;	1273	coroapi.current = coro_current;
1179		1274
1180	GCoroAPI = &coroapi;	1275	GCoroAPI = &coroapi;
1181	sv_setiv (sv, (IV)&coroapi);	1276	sv_setiv (sv, (IV)&coroapi);
1182	SvREADONLY_on (sv);	1277	SvREADONLY_on (sv);
1183	}	1278	}
1184	}	1279	}
		1280
		1281	void
		1282	_set_current (SV *current)
		1283	PROTOTYPE: $
		1284	CODE:
		1285	SvREFCNT_dec (SvRV (coro_current));
		1286	SvRV_set (coro_current, SvREFCNT_inc (SvRV (current)));
1185		1287
1186	int	1288	int
1187	prio (Coro::State coro, int newprio = 0)	1289	prio (Coro::State coro, int newprio = 0)
1188	ALIAS:	1290	ALIAS:
1189	nice = 1	1291	nice = 1
…		…
1192	RETVAL = coro->prio;	1294	RETVAL = coro->prio;
1193		1295
1194	if (items > 1)	1296	if (items > 1)
1195	{	1297	{
1196	if (ix)	1298	if (ix)
1197	newprio += coro->prio;	1299	newprio = coro->prio - newprio;
1198		1300
1199	if (newprio < PRIO_MIN) newprio = PRIO_MIN;	1301	if (newprio < PRIO_MIN) newprio = PRIO_MIN;
1200	if (newprio > PRIO_MAX) newprio = PRIO_MAX;	1302	if (newprio > PRIO_MAX) newprio = PRIO_MAX;
1201		1303
1202	coro->prio = newprio;	1304	coro->prio = newprio;
1203	}	1305	}
1204	}	1306	}
		1307	OUTPUT:
		1308	RETVAL
1205		1309
1206	SV *	1310	SV *
1207	ready (SV *self)	1311	ready (SV *self)
1208	PROTOTYPE: $	1312	PROTOTYPE: $
1209	CODE:	1313	CODE:
…		…
1225	CODE:	1329	CODE:
1226	RETVAL = coro_nready;	1330	RETVAL = coro_nready;
1227	OUTPUT:	1331	OUTPUT:
1228	RETVAL	1332	RETVAL
1229		1333
1230	void
1231	_set_current (SV *current)
1232	PROTOTYPE: $
1233	CODE:
1234	SvREFCNT_dec (SvRV (coro_current));
1235	SvRV_set (coro_current, SvREFCNT_inc (SvRV (current)));
1236
1237	MODULE = Coro::State PACKAGE = Coro::AIO	1334	MODULE = Coro::State PACKAGE = Coro::AIO
1238		1335
1239	SV *	1336	SV *
1240	_get_state ()	1337	_get_state ()
1241	CODE:	1338	CODE:

Diff Legend

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

Comparing Coro/Coro/State.xs (file contents): Revision 1.121 by root, Sat Dec 2 20:40:25 2006 UTC vs. Revision 1.135 by root, Fri Jan 5 18:25:51 2007 UTC

Diff Legend

Comparing Coro/Coro/State.xs (file contents):
Revision 1.121 by root, Sat Dec 2 20:40:25 2006 UTC vs.
Revision 1.135 by root, Fri Jan 5 18:25:51 2007 UTC