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

Comparing Coro/Coro/State.xs (file contents):
Revision 1.106 by root, Mon Nov 27 02:08:55 2006 UTC vs.
Revision 1.115 by root, Fri Dec 1 13:36:08 2006 UTC

…		…
7	#include "patchlevel.h"	7	#include "patchlevel.h"
8		8
9	#if USE_VALGRIND	9	#if USE_VALGRIND
10	# include <valgrind/valgrind.h>	10	# include <valgrind/valgrind.h>
11	#endif	11	#endif
		12
		13	/* the maximum number of idle cctx that will be pooled */
		14	#define MAX_IDLE_CCTX 8
12		15
13	#define PERL_VERSION_ATLEAST(a,b,c) \	16	#define PERL_VERSION_ATLEAST(a,b,c) \
14	(PERL_REVISION > (a) \	17	(PERL_REVISION > (a) \
15	\|\| (PERL_REVISION == (a) \	18	\|\| (PERL_REVISION == (a) \
16	&& (PERL_VERSION > (b) \	19	&& (PERL_VERSION > (b) \
…		…
103	static struct CoroAPI coroapi;	106	static struct CoroAPI coroapi;
104	static AV main_mainstack; / used to differentiate between $main and others */	107	static AV main_mainstack; / used to differentiate between $main and others */
105	static HV coro_state_stash, coro_stash;	108	static HV coro_state_stash, coro_stash;
106	static SV coro_mortal; / will be freed after next transfer */	109	static SV coro_mortal; / will be freed after next transfer */
107		110
		111	static struct coro_cctx *cctx_first;
		112	static int cctx_count, cctx_idle;
		113
108	/* this is a structure representing a c-level coroutine */	114	/* this is a structure representing a c-level coroutine */
109	typedef struct coro_cctx {	115	typedef struct coro_cctx {
110	struct coro_cctx *next;	116	struct coro_cctx *next;
111		117
112	/* the stack */	118	/* the stack */
…		…
116	/* cpu state */	122	/* cpu state */
117	void idle_sp; / sp of top-level transfer/schedule/cede call */	123	void idle_sp; / sp of top-level transfer/schedule/cede call */
118	JMPENV *top_env;	124	JMPENV *top_env;
119	coro_context cctx;	125	coro_context cctx;
120		126
		127	int inuse;
		128
121	#if USE_VALGRIND	129	#if USE_VALGRIND
122	int valgrind_id;	130	int valgrind_id;
123	#endif	131	#endif
124	} coro_cctx;	132	} coro_cctx;
		133
		134	enum {
		135	CF_RUNNING, /* coroutine is running */
		136	CF_READY, /* coroutine is ready */
		137	};
125		138
126	/* this is a structure representing a perl-level coroutine */	139	/* this is a structure representing a perl-level coroutine */
127	struct coro {	140	struct coro {
128	/* the c coroutine allocated to this perl coroutine, if any */	141	/* the c coroutine allocated to this perl coroutine, if any */
129	coro_cctx *cctx;	142	coro_cctx *cctx;
130		143
131	/* data associated with this coroutine (initial args) */	144	/* data associated with this coroutine (initial args) */
132	AV *args;	145	AV *args;
133	int refcnt;	146	int refcnt;
		147	int flags;
134		148
135	/* optionally saved, might be zero */	149	/* optionally saved, might be zero */
136	AV *defav;	150	AV *defav;
137	SV *defsv;	151	SV *defsv;
138	SV *errsv;	152	SV *errsv;
139		153
140	/* saved global state not related to stacks */	154	#define VAR(name,type) type name;
141	U8 dowarn;	155	# include "state.h"
142	I32 in_eval;	156	#undef VAR
143
144	/* the stacks and related info (callchain etc..) */
145	PERL_SI *curstackinfo;
146	AV *curstack;
147	AV *mainstack;
148	SV **stack_sp;
149	OP *op;
150	SV **curpad;
151	AV *comppad;
152	CV *compcv;
153	SV **stack_base;
154	SV **stack_max;
155	SV **tmps_stack;
156	I32 tmps_floor;
157	I32 tmps_ix;
158	I32 tmps_max;
159	I32 *markstack;
160	I32 *markstack_ptr;
161	I32 *markstack_max;
162	I32 *scopestack;
163	I32 scopestack_ix;
164	I32 scopestack_max;
165	ANY *savestack;
166	I32 savestack_ix;
167	I32 savestack_max;
168	OP **retstack;
169	I32 retstack_ix;
170	I32 retstack_max;
171	PMOP *curpm;
172	COP *curcop;
173		157
174	/* coro process data */	158	/* coro process data */
175	int prio;	159	int prio;
176	};	160	};
177		161
…		…
241		225
242	#define PERL_MAGIC_coro PERL_MAGIC_ext	226	#define PERL_MAGIC_coro PERL_MAGIC_ext
243		227
244	static MGVTBL vtbl_coro = {0, 0, 0, 0, coro_cv_free};	228	static MGVTBL vtbl_coro = {0, 0, 0, 0, coro_cv_free};
245		229
		230	#define CORO_MAGIC(cv) \
		231	SvMAGIC (cv) \
		232	? SvMAGIC (cv)->mg_type == PERL_MAGIC_coro \
		233	? SvMAGIC (cv) \
		234	: mg_find ((SV *)cv, PERL_MAGIC_coro) \
		235	: 0
		236
246	/* the next two functions merely cache the padlists */	237	/* the next two functions merely cache the padlists */
247	static void	238	static void
248	get_padlist (CV *cv)	239	get_padlist (CV *cv)
249	{	240	{
250	MAGIC mg = mg_find ((SV )cv, PERL_MAGIC_coro);	241	MAGIC *mg = CORO_MAGIC (cv);
		242	AV *av;
251		243
252	if (mg && AvFILLp ((AV *)mg->mg_obj) >= 0)	244	if (mg && AvFILLp ((av = (AV *)mg->mg_obj)) >= 0)
253	CvPADLIST (cv) = (AV )av_pop ((AV )mg->mg_obj);	245	CvPADLIST (cv) = (AV *)AvARRAY (av)[AvFILLp (av)--];
254	else	246	else
255	{	247	{
256	#if 0	248	#if 0
257	/* this is probably cleaner, but also slower? */	249	/* this is probably cleaner, but also slower? */
258	CV *cp = Perl_cv_clone (cv);	250	CV *cp = Perl_cv_clone (cv);
…		…
266	}	258	}
267		259
268	static void	260	static void
269	put_padlist (CV *cv)	261	put_padlist (CV *cv)
270	{	262	{
271	MAGIC mg = mg_find ((SV )cv, PERL_MAGIC_coro);	263	MAGIC *mg = CORO_MAGIC (cv);
		264	AV *av;
272		265
273	if (!mg)	266	if (!mg)
274	{	267	{
275	sv_magic ((SV *)cv, 0, PERL_MAGIC_coro, 0, 0);	268	sv_magic ((SV *)cv, 0, PERL_MAGIC_coro, 0, 0);
276	mg = mg_find ((SV *)cv, PERL_MAGIC_coro);	269	mg = mg_find ((SV *)cv, PERL_MAGIC_coro);
277	mg->mg_virtual = &vtbl_coro;	270	mg->mg_virtual = &vtbl_coro;
278	mg->mg_obj = (SV *)newAV ();	271	mg->mg_obj = (SV *)newAV ();
279	}	272	}
280		273
281	av_push ((AV )mg->mg_obj, (SV )CvPADLIST (cv));	274	av = (AV *)mg->mg_obj;
		275
		276	if (AvFILLp (av) >= AvMAX (av))
		277	av_extend (av, AvMAX (av) + 1);
		278
		279	AvARRAY (av)[++AvFILLp (av)] = (SV *)CvPADLIST (cv);
282	}	280	}
283		281
284	#define SB do {	282	#define SB do {
285	#define SE } while (0)	283	#define SE } while (0)
286		284
…		…
290	#define REPLACE_SV(sv,val) SB SvREFCNT_dec(sv); (sv) = (val); (val) = 0; SE	288	#define REPLACE_SV(sv,val) SB SvREFCNT_dec(sv); (sv) = (val); (val) = 0; SE
291		289
292	static void	290	static void
293	load_state(Coro__State c)	291	load_state(Coro__State c)
294	{	292	{
295	PL_dowarn = c->dowarn;	293	#define VAR(name,type) PL_ ## name = c->name;
296	PL_in_eval = c->in_eval;	294	# include "state.h"
297		295	#undef VAR
298	PL_curstackinfo = c->curstackinfo;
299	PL_curstack = c->curstack;
300	PL_mainstack = c->mainstack;
301	PL_stack_sp = c->stack_sp;
302	PL_op = c->op;
303	PL_curpad = c->curpad;
304	PL_comppad = c->comppad;
305	PL_compcv = c->compcv;
306	PL_stack_base = c->stack_base;
307	PL_stack_max = c->stack_max;
308	PL_tmps_stack = c->tmps_stack;
309	PL_tmps_floor = c->tmps_floor;
310	PL_tmps_ix = c->tmps_ix;
311	PL_tmps_max = c->tmps_max;
312	PL_markstack = c->markstack;
313	PL_markstack_ptr = c->markstack_ptr;
314	PL_markstack_max = c->markstack_max;
315	PL_scopestack = c->scopestack;
316	PL_scopestack_ix = c->scopestack_ix;
317	PL_scopestack_max = c->scopestack_max;
318	PL_savestack = c->savestack;
319	PL_savestack_ix = c->savestack_ix;
320	PL_savestack_max = c->savestack_max;
321	#if !PERL_VERSION_ATLEAST (5,9,0)
322	PL_retstack = c->retstack;
323	PL_retstack_ix = c->retstack_ix;
324	PL_retstack_max = c->retstack_max;
325	#endif
326	PL_curpm = c->curpm;
327	PL_curcop = c->curcop;
328		296
329	if (c->defav) REPLACE_SV (GvAV (PL_defgv), c->defav);	297	if (c->defav) REPLACE_SV (GvAV (PL_defgv), c->defav);
330	if (c->defsv) REPLACE_SV (DEFSV , c->defsv);	298	if (c->defsv) REPLACE_SV (DEFSV , c->defsv);
331	if (c->errsv) REPLACE_SV (ERRSV , c->errsv);	299	if (c->errsv) REPLACE_SV (ERRSV , c->errsv);
332		300
…		…
335	CV *cv;	303	CV *cv;
336		304
337	/* now do the ugly restore mess */	305	/* now do the ugly restore mess */
338	while ((cv = (CV *)POPs))	306	while ((cv = (CV *)POPs))
339	{	307	{
340	AV padlist = (AV )POPs;
341
342	if (padlist)
343	{
344	put_padlist (cv); /* mark this padlist as available */	308	put_padlist (cv); /* mark this padlist as available */
345	CvPADLIST(cv) = padlist;	309	CvDEPTH (cv) = PTR2IV (POPs);
346	}	310	CvPADLIST (cv) = (AV *)POPs;
347
348	++CvDEPTH(cv);
349	}	311	}
350		312
351	PUTBACK;	313	PUTBACK;
352	}	314	}
353	}	315	}
…		…
375	PERL_CONTEXT *cx = &ccstk[cxix--];	337	PERL_CONTEXT *cx = &ccstk[cxix--];
376		338
377	if (CxTYPE(cx) == CXt_SUB)	339	if (CxTYPE(cx) == CXt_SUB)
378	{	340	{
379	CV *cv = cx->blk_sub.cv;	341	CV *cv = cx->blk_sub.cv;
		342
380	if (CvDEPTH(cv))	343	if (CvDEPTH (cv))
381	{	344	{
382	EXTEND (SP, CvDEPTH(cv)*2);	345	EXTEND (SP, 3);
383
384	while (--CvDEPTH(cv))
385	{
386	/* this tells the restore code to increment CvDEPTH */
387	PUSHs (Nullsv);
388	PUSHs ((SV *)cv);
389	}
390		346
391	PUSHs ((SV *)CvPADLIST(cv));	347	PUSHs ((SV *)CvPADLIST(cv));
		348	PUSHs (INT2PTR (SV *, CvDEPTH (cv)));
392	PUSHs ((SV *)cv);	349	PUSHs ((SV *)cv);
393		350
		351	CvDEPTH (cv) = 0;
394	get_padlist (cv);	352	get_padlist (cv);
395	}	353	}
396	}	354	}
397	#ifdef CXt_FORMAT	355	#ifdef CXt_FORMAT
398	else if (CxTYPE(cx) == CXt_FORMAT)	356	else if (CxTYPE(cx) == CXt_FORMAT)
…		…
417		375
418	c->defav = flags & TRANSFER_SAVE_DEFAV ? (AV *)SvREFCNT_inc (GvAV (PL_defgv)) : 0;	376	c->defav = flags & TRANSFER_SAVE_DEFAV ? (AV *)SvREFCNT_inc (GvAV (PL_defgv)) : 0;
419	c->defsv = flags & TRANSFER_SAVE_DEFSV ? SvREFCNT_inc (DEFSV) : 0;	377	c->defsv = flags & TRANSFER_SAVE_DEFSV ? SvREFCNT_inc (DEFSV) : 0;
420	c->errsv = flags & TRANSFER_SAVE_ERRSV ? SvREFCNT_inc (ERRSV) : 0;	378	c->errsv = flags & TRANSFER_SAVE_ERRSV ? SvREFCNT_inc (ERRSV) : 0;
421		379
422	c->dowarn = PL_dowarn;	380	#define VAR(name,type)c->name = PL_ ## name;
423	c->in_eval = PL_in_eval;	381	# include "state.h"
424		382	#undef VAR
425	c->curstackinfo = PL_curstackinfo;
426	c->curstack = PL_curstack;
427	c->mainstack = PL_mainstack;
428	c->stack_sp = PL_stack_sp;
429	c->op = PL_op;
430	c->curpad = PL_curpad;
431	c->comppad = PL_comppad;
432	c->compcv = PL_compcv;
433	c->stack_base = PL_stack_base;
434	c->stack_max = PL_stack_max;
435	c->tmps_stack = PL_tmps_stack;
436	c->tmps_floor = PL_tmps_floor;
437	c->tmps_ix = PL_tmps_ix;
438	c->tmps_max = PL_tmps_max;
439	c->markstack = PL_markstack;
440	c->markstack_ptr = PL_markstack_ptr;
441	c->markstack_max = PL_markstack_max;
442	c->scopestack = PL_scopestack;
443	c->scopestack_ix = PL_scopestack_ix;
444	c->scopestack_max = PL_scopestack_max;
445	c->savestack = PL_savestack;
446	c->savestack_ix = PL_savestack_ix;
447	c->savestack_max = PL_savestack_max;
448	#if !PERL_VERSION_ATLEAST (5,9,0)
449	c->retstack = PL_retstack;
450	c->retstack_ix = PL_retstack_ix;
451	c->retstack_max = PL_retstack_max;
452	#endif
453	c->curpm = PL_curpm;
454	c->curcop = PL_curcop;
455	}	383	}
456		384
457	/*	385	/*
458	* allocate various perl stacks. This is an exact copy	386	* allocate various perl stacks. This is an exact copy
459	* of perl.c:init_stacks, except that it uses less memory	387	* of perl.c:init_stacks, except that it uses less memory
…		…
578	myop.op_flags = OPf_WANT_VOID;	506	myop.op_flags = OPf_WANT_VOID;
579		507
580	PL_op = (OP *)&myop;	508	PL_op = (OP *)&myop;
581		509
582	PUSHMARK (SP);	510	PUSHMARK (SP);
583	XPUSHs ((SV *)get_cv ("Coro::State::coro_init", FALSE));	511	XPUSHs ((SV *)get_cv ("Coro::State::_coro_init", FALSE));
584	PUTBACK;	512	PUTBACK;
585	PL_op = PL_ppaddr[OP_ENTERSUB](aTHX);	513	PL_op = PL_ppaddr[OP_ENTERSUB](aTHX);
586	SPAGAIN;	514	SPAGAIN;
587		515
588	ENTER; /* necessary e.g. for dounwind */	516	ENTER; /* necessary e.g. for dounwind */
…		…
607		535
608	Zero (&myop, 1, LOGOP);	536	Zero (&myop, 1, LOGOP);
609	myop.op_next = PL_op;	537	myop.op_next = PL_op;
610	myop.op_flags = OPf_WANT_VOID;	538	myop.op_flags = OPf_WANT_VOID;
611		539
612	sv_setiv (get_sv ("Coro::State::cctx", FALSE), PTR2IV (cctx));	540	sv_setiv (get_sv ("Coro::State::_cctx", FALSE), PTR2IV (cctx));
613		541
614	PUSHMARK (SP);	542	PUSHMARK (SP);
615	XPUSHs ((SV *)get_cv ("Coro::State::cctx_init", FALSE));	543	XPUSHs ((SV *)get_cv ("Coro::State::_cctx_init", FALSE));
616	PUTBACK;	544	PUTBACK;
617	PL_restartop = PL_ppaddr[OP_ENTERSUB](aTHX);	545	PL_restartop = PL_ppaddr[OP_ENTERSUB](aTHX);
618	SPAGAIN;	546	SPAGAIN;
619	}	547	}
620		548
…		…
626		554
627	/*	555	/*
628	* this is a _very_ stripped down perl interpreter ;)	556	* this is a _very_ stripped down perl interpreter ;)
629	*/	557	*/
630	PL_top_env = &PL_start_env;	558	PL_top_env = &PL_start_env;
		559
631	/* inject call to cctx_init */	560	/* inject call to cctx_init */
632	prepare_cctx ((coro_cctx *)arg);	561	prepare_cctx ((coro_cctx *)arg);
633		562
634	/* somebody will hit me for both perl_run and PL_restartop */	563	/* somebody will hit me for both perl_run and PL_restartop */
635	perl_run (PL_curinterp);	564	perl_run (PL_curinterp);
…		…
640		569
641	static coro_cctx *	570	static coro_cctx *
642	cctx_new ()	571	cctx_new ()
643	{	572	{
644	coro_cctx *cctx;	573	coro_cctx *cctx;
		574
		575	++cctx_count;
645		576
646	New (0, cctx, 1, coro_cctx);	577	New (0, cctx, 1, coro_cctx);
647		578
648	#if HAVE_MMAP	579	#if HAVE_MMAP
649		580
…		…
685		616
686	return cctx;	617	return cctx;
687	}	618	}
688		619
689	static void	620	static void
690	cctx_free (coro_cctx *cctx)	621	cctx_destroy (coro_cctx *cctx)
691	{	622	{
692	if (!cctx)	623	if (!cctx)
693	return;	624	return;
		625
		626	--cctx_count;
694		627
695	#if USE_VALGRIND	628	#if USE_VALGRIND
696	VALGRIND_STACK_DEREGISTER (cctx->valgrind_id);	629	VALGRIND_STACK_DEREGISTER (cctx->valgrind_id);
697	#endif	630	#endif
698		631
…		…
703	#endif	636	#endif
704		637
705	Safefree (cctx);	638	Safefree (cctx);
706	}	639	}
707		640
708	static coro_cctx *cctx_first;
709	static int cctx_count, cctx_idle;
710
711	static coro_cctx *	641	static coro_cctx *
712	cctx_get ()	642	cctx_get ()
713	{	643	{
714	coro_cctx *cctx;	644	coro_cctx *cctx;
715		645
716	if (cctx_first)	646	if (cctx_first)
717	{	647	{
718	--cctx_idle;
719	cctx = cctx_first;	648	cctx = cctx_first;
720	cctx_first = cctx->next;	649	cctx_first = cctx->next;
		650	--cctx_idle;
721	}	651	}
722	else	652	else
723	{	653	{
724	++cctx_count;
725	cctx = cctx_new ();	654	cctx = cctx_new ();
726	PL_op = PL_op->op_next;	655	PL_op = PL_op->op_next;
727	}	656	}
728		657
729	return cctx;	658	return cctx;
730	}	659	}
731		660
732	static void	661	static void
733	cctx_put (coro_cctx *cctx)	662	cctx_put (coro_cctx *cctx)
734	{	663	{
		664	/* free another cctx if overlimit */
		665	if (cctx_idle >= MAX_IDLE_CCTX)
		666	{
		667	coro_cctx *first = cctx_first;
		668	cctx_first = first->next;
		669	--cctx_idle;
		670
		671	assert (!first->inuse);
		672	cctx_destroy (first);
		673	}
		674
735	++cctx_idle;	675	++cctx_idle;
736	cctx->next = cctx_first;	676	cctx->next = cctx_first;
737	cctx_first = cctx;	677	cctx_first = cctx;
738	}	678	}
739		679
…		…
747	if (flags == TRANSFER_SET_STACKLEVEL)	687	if (flags == TRANSFER_SET_STACKLEVEL)
748	((coro_cctx *)prev)->idle_sp = STACKLEVEL;	688	((coro_cctx *)prev)->idle_sp = STACKLEVEL;
749	else if (prev != next)	689	else if (prev != next)
750	{	690	{
751	coro_cctx *prev__cctx;	691	coro_cctx *prev__cctx;
		692
		693	if (!prev->cctx)
		694	{
		695	/* create a new empty context */
		696	Newz (0, prev->cctx, 1, coro_cctx);
		697	prev->cctx->inuse = 1;
		698	prev->flags \|= CF_RUNNING;
		699	}
		700
		701	if (!prev->flags & CF_RUNNING)
		702	croak ("Coro::State::transfer called with non-running prev Coro::State, but can only transfer from running states");
		703
		704	if (next->flags & CF_RUNNING)
		705	croak ("Coro::State::transfer called with running next Coro::State, but can only transfer to inactive states");
		706
		707	prev->flags &= ~CF_RUNNING;
		708	next->flags \|= CF_RUNNING;
752		709
753	LOCK;	710	LOCK;
754		711
755	if (next->mainstack)	712	if (next->mainstack)
756	{	713	{
…		…
763	/* need to start coroutine */	720	/* need to start coroutine */
764	/* first get rid of the old state */	721	/* first get rid of the old state */
765	SAVE (prev, -1);	722	SAVE (prev, -1);
766	/* setup coroutine call */	723	/* setup coroutine call */
767	setup_coro (next);	724	setup_coro (next);
768	/* need a stack */	725	/* need a new stack */
769	next->cctx = 0;	726	assert (!next->stack);
770	}	727	}
771
772	if (!prev->cctx)
773	/* create a new empty context */
774	Newz (0, prev->cctx, 1, coro_cctx);
775		728
776	prev__cctx = prev->cctx;	729	prev__cctx = prev->cctx;
777		730
778	/* possibly "free" the cctx */	731	/* possibly "free" the cctx */
779	if (prev__cctx->idle_sp == STACKLEVEL)	732	if (prev__cctx->idle_sp == STACKLEVEL)
780	{	733	{
		734	/* I assume that STACKLEVEL is a stronger indicator than PL_top_env changes */
		735	assert (PL_top_env == prev__cctx->top_env);
		736
781	cctx_put (prev__cctx);	737	cctx_put (prev__cctx);
782	prev->cctx = 0;	738	prev->cctx = 0;
783	}	739	}
784		740
785	if (!next->cctx)	741	if (!next->cctx)
786	next->cctx = cctx_get ();	742	next->cctx = cctx_get ();
787		743
788	if (prev__cctx != next->cctx)	744	if (prev__cctx != next->cctx)
789	{	745	{
		746	assert ( prev__cctx->inuse);
		747	assert (!next->cctx->inuse);
		748
		749	prev__cctx->inuse = 0;
		750	next->cctx->inuse = 1;
		751
790	prev__cctx->top_env = PL_top_env;	752	prev__cctx->top_env = PL_top_env;
791	PL_top_env = next->cctx->top_env;	753	PL_top_env = next->cctx->top_env;
792	coro_transfer (&prev__cctx->cctx, &next->cctx->cctx);	754	coro_transfer (&prev__cctx->cctx, &next->cctx->cctx);
793	}	755	}
794		756
…		…
810	coro_state_destroy (struct coro *coro)	772	coro_state_destroy (struct coro *coro)
811	{	773	{
812	if (coro->refcnt--)	774	if (coro->refcnt--)
813	return;	775	return;
814		776
		777	if (coro->flags & CF_RUNNING)
		778	croak ("FATAL: tried to destroy currently running coroutine");
		779
815	if (coro->mainstack && coro->mainstack != main_mainstack)	780	if (coro->mainstack && coro->mainstack != main_mainstack)
816	{	781	{
817	struct coro temp;	782	struct coro temp;
818		783
819	SAVE ((&temp), TRANSFER_SAVE_ALL);	784	SAVE ((&temp), TRANSFER_SAVE_ALL);
…		…
824	LOAD ((&temp)); /* this will get rid of defsv etc.. */	789	LOAD ((&temp)); /* this will get rid of defsv etc.. */
825		790
826	coro->mainstack = 0;	791	coro->mainstack = 0;
827	}	792	}
828		793
829	cctx_free (coro->cctx);	794	cctx_destroy (coro->cctx);
830	SvREFCNT_dec (coro->args);	795	SvREFCNT_dec (coro->args);
831	Safefree (coro);	796	Safefree (coro);
832	}	797	}
833		798
834	static int	799	static int
…		…
916	static GV coro_current, coro_idle;	881	static GV coro_current, coro_idle;
917	static AV *coro_ready [PRIO_MAX-PRIO_MIN+1];	882	static AV *coro_ready [PRIO_MAX-PRIO_MIN+1];
918	static int coro_nready;	883	static int coro_nready;
919		884
920	static void	885	static void
921	coro_enq (SV *sv)	886	coro_enq (SV *coro_sv)
922	{	887	{
923	int prio;
924
925	if (SvTYPE (sv) != SVt_PVHV)
926	croak ("Coro::ready tried to enqueue something that is not a coroutine");
927
928	prio = SvSTATE (sv)->prio;
929
930	av_push (coro_ready [prio - PRIO_MIN], sv);	888	av_push (coro_ready [SvSTATE (coro_sv)->prio - PRIO_MIN], coro_sv);
931	coro_nready++;	889	coro_nready++;
932	}	890	}
933		891
934	static SV *	892	static SV *
935	coro_deq (int min_prio)	893	coro_deq (int min_prio)
…		…
948	}	906	}
949		907
950	return 0;	908	return 0;
951	}	909	}
952		910
953	static void	911	static int
954	api_ready (SV *coro)	912	api_ready (SV *coro_sv)
955	{	913	{
956	dTHX;	914	struct coro *coro;
957		915
958	if (SvROK (coro))	916	if (SvROK (coro_sv))
959	coro = SvRV (coro);	917	coro_sv = SvRV (coro_sv);
		918
		919	coro = SvSTATE (coro_sv);
		920
		921	if (coro->flags & CF_READY)
		922	return 0;
		923
		924	if (coro->flags & CF_RUNNING)
		925	croak ("Coro::ready called on currently running coroutine");
		926
		927	coro->flags \|= CF_READY;
960		928
961	LOCK;	929	LOCK;
962	coro_enq (SvREFCNT_inc (coro));	930	coro_enq (SvREFCNT_inc (coro_sv));
963	UNLOCK;	931	UNLOCK;
		932
		933	return 1;
		934	}
		935
		936	static int
		937	api_is_ready (SV *coro_sv)
		938	{
		939	return !!SvSTATE (coro_sv)->flags & CF_READY;
964	}	940	}
965		941
966	static void	942	static void
967	prepare_schedule (struct transfer_args *ta)	943	prepare_schedule (struct transfer_args *ta)
968	{	944	{
…		…
1004	coro_mortal = prev;	980	coro_mortal = prev;
1005		981
1006	ta->prev = SvSTATE (prev);	982	ta->prev = SvSTATE (prev);
1007	ta->next = SvSTATE (next);	983	ta->next = SvSTATE (next);
1008	ta->flags = TRANSFER_SAVE_ALL;	984	ta->flags = TRANSFER_SAVE_ALL;
		985
		986	ta->next->flags &= ~CF_READY;
1009	}	987	}
1010		988
1011	static void	989	static void
1012	prepare_cede (struct transfer_args *ta)	990	prepare_cede (struct transfer_args *ta)
1013	{	991	{
1014	LOCK;	992	api_ready (GvSV (coro_current));
1015	coro_enq (SvREFCNT_inc (SvRV (GvSV (coro_current))));
1016	UNLOCK;
1017		993
1018	prepare_schedule (ta);	994	prepare_schedule (ta);
1019	}	995	}
1020		996
1021	static void	997	static void
…		…
1207	SV *sv = perl_get_sv("Coro::API", 1);	1183	SV *sv = perl_get_sv("Coro::API", 1);
1208		1184
1209	coroapi.schedule = api_schedule;	1185	coroapi.schedule = api_schedule;
1210	coroapi.cede = api_cede;	1186	coroapi.cede = api_cede;
1211	coroapi.ready = api_ready;	1187	coroapi.ready = api_ready;
		1188	coroapi.is_ready = api_is_ready;
1212	coroapi.nready = &coro_nready;	1189	coroapi.nready = &coro_nready;
1213	coroapi.current = coro_current;	1190	coroapi.current = coro_current;
1214		1191
1215	GCoroAPI = &coroapi;	1192	GCoroAPI = &coroapi;
1216	sv_setiv (sv, (IV)&coroapi);	1193	sv_setiv (sv, (IV)&coroapi);
…		…
1236		1213
1237	coro->prio = newprio;	1214	coro->prio = newprio;
1238	}	1215	}
1239	}	1216	}
1240		1217
1241	void	1218	SV *
1242	ready (SV *self)	1219	ready (SV *self)
1243	PROTOTYPE: $	1220	PROTOTYPE: $
1244	CODE:	1221	CODE:
1245	api_ready (self);	1222	RETVAL = boolSV (api_ready (self));
		1223	OUTPUT:
		1224	RETVAL
		1225
		1226	SV *
		1227	is_ready (SV *self)
		1228	PROTOTYPE: $
		1229	CODE:
		1230	RETVAL = boolSV (api_is_ready (self));
		1231	OUTPUT:
		1232	RETVAL
1246		1233
1247	int	1234	int
1248	nready (...)	1235	nready (...)
1249	PROTOTYPE:	1236	PROTOTYPE:
1250	CODE:	1237	CODE:

Diff Legend

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

Comparing Coro/Coro/State.xs (file contents): Revision 1.106 by root, Mon Nov 27 02:08:55 2006 UTC vs. Revision 1.115 by root, Fri Dec 1 13:36:08 2006 UTC

Diff Legend

Comparing Coro/Coro/State.xs (file contents):
Revision 1.106 by root, Mon Nov 27 02:08:55 2006 UTC vs.
Revision 1.115 by root, Fri Dec 1 13:36:08 2006 UTC