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

Comparing Coro/Coro/State.xs (file contents):
Revision 1.8 by root, Thu Jul 19 04:13:22 2001 UTC vs.
Revision 1.15 by root, Wed Jul 25 04:14:38 2001 UTC

…		…
1	#include "EXTERN.h"	1	#include "EXTERN.h"
2	#include "perl.h"	2	#include "perl.h"
3	#include "XSUB.h"	3	#include "XSUB.h"
4		4
5	#if 1	5	#include "libcoro/coro.c"
6	# define CHK(x) (void *)0	6
		7	#ifdef HAVE_MMAP
		8	# include <unistd.h>
		9	# include <sys/mman.h>
		10	#endif
		11
		12	#define MAY_FLUSH /* increases codesize */
		13
		14	/* perl-related */
		15	#define TRANSFER_SAVE_DEFAV 0x00000001
		16	#define TRANSFER_SAVE_DEFSV 0x00000002
		17	#define TRANSFER_SAVE_ERRSV 0x00000004
		18	/* c-related */
		19	#define TRANSFER_SAVE_CCTXT 0x00000008
		20	#ifdef CORO_LAZY_STACK
		21	# define TRANSFER_LAZY_STACK 0x00000010
7	#else	22	#else
8	# define CHK(x) if (!(x)) croak("FATAL, CHK: " #x)	23	# define TRANSFER_LAZY_STACK 0x00000000
9	#endif	24	#endif
10		25
11	#define MAY_FLUSH /* increases codesize */	26	#define TRANSFER_SAVE_ALL (TRANSFER_SAVE_DEFAV\|TRANSFER_SAVE_DEFSV \
		27	\|TRANSFER_SAVE_ERRSV\|TRANSFER_SAVE_CCTXT)
12		28
13	#define SUB_INIT "Coro::State::_newcoro"	29	#define SUB_INIT "Coro::State::initialize"
		30	#define UCORO_STATE "_coro_state"
14		31
15	#define SAVE_DEFAV 0x00000001	32	/* The next macro should delcare a variable stacklevel that contains and approximation
16	#define SAVE_DEFSV 0x00000002	33	* to the current C stack pointer. It's property is that it changes with each call
17	#define SAVE_ERRSV 0x00000004	34	* and should be unique. */
		35	#define dSTACKLEVEL void *stacklevel = &stacklevel
18		36
19	#define SAVE_ALL -1	37	#define labs(l) ((l) >= 0 ? (l) : -(l))
		38
		39	/* this is actually not only the c stack but also c registers etc... */
		40	typedef struct {
		41	int refcnt; /* pointer reference counter */
		42	int usecnt; /* shared by how many coroutines */
		43	int gencnt; /* generation counter */
		44
		45	coro_context cctx;
		46
		47	void *sptr;
		48	long ssize; /* positive == mmap, otherwise malloc */
		49	} coro_stack;
		50
		51	static coro_stack main_stack = { 1, 0, 0 };
20		52
21	struct coro {	53	struct coro {
		54	/* the optional C context */
		55	coro_stack *stack;
		56	void *cursp;
		57	int gencnt;
		58
22	/* optionally saved, might be zero */	59	/* optionally saved, might be zero */
23	AV *defav;	60	AV *defav;
24	SV *defsv;	61	SV *defsv;
25	SV *errsv;	62	SV *errsv;
26		63
51	I32 savestack_max;	88	I32 savestack_max;
52	OP **retstack;	89	OP **retstack;
53	I32 retstack_ix;	90	I32 retstack_ix;
54	I32 retstack_max;	91	I32 retstack_max;
55	COP *curcop;	92	COP *curcop;
		93	JMPENV start_env;
		94	JMPENV *top_env;
56		95
57	/* data associated with this coroutine (initial args) */	96	/* data associated with this coroutine (initial args) */
58	AV *args;	97	AV *args;
59	};	98	};
60		99
61	typedef struct coro *Coro__State;	100	typedef struct coro *Coro__State;
62	typedef struct coro *Coro__State_or_hashref;	101	typedef struct coro *Coro__State_or_hashref;
63		102
		103	static AV main_mainstack; / used to differentiate between $main and others */
		104	static HV *coro_state_stash;
		105	static SV *ucoro_state_sv;
		106	static U32 ucoro_state_hash;
64	static HV *padlist_cache;	107	static HV *padlist_cache;
65		108
66	/* mostly copied from op.c:cv_clone2 */	109	/* mostly copied from op.c:cv_clone2 */
67	STATIC AV *	110	STATIC AV *
68	clone_padlist (AV *protopadlist)	111	clone_padlist (AV *protopadlist)
…		…
231	#endif	274	#endif
232		275
233	#define SB do {	276	#define SB do {
234	#define SE } while (0)	277	#define SE } while (0)
235		278
236	#define LOAD(state) SB load_state(aTHX_ state); SPAGAIN; SE	279	#define LOAD(state) SB load_state(aTHX_ (state)); SPAGAIN; SE
237	#define SAVE(state,flags) SB PUTBACK; save_state(aTHX_ state,flags); SE	280	#define SAVE(state,flags) SB PUTBACK; save_state(aTHX_ (state),(flags)); SE
238		281
239	#define REPLACE_SV(sv,val) SB SvREFCNT_dec(sv); (sv) = (val); SE	282	#define REPLACE_SV(sv,val) SB SvREFCNT_dec(sv); (sv) = (val); SE
240		283
241	static void	284	static void
242	load_state(pTHX_ Coro__State c)	285	load_state(pTHX_ Coro__State c)
…		…
266	PL_savestack_max = c->savestack_max;	309	PL_savestack_max = c->savestack_max;
267	PL_retstack = c->retstack;	310	PL_retstack = c->retstack;
268	PL_retstack_ix = c->retstack_ix;	311	PL_retstack_ix = c->retstack_ix;
269	PL_retstack_max = c->retstack_max;	312	PL_retstack_max = c->retstack_max;
270	PL_curcop = c->curcop;	313	PL_curcop = c->curcop;
		314	PL_start_env = c->start_env;
		315	PL_top_env = c->top_env;
271		316
272	if (c->defav) REPLACE_SV (GvAV (PL_defgv), c->defav);	317	if (c->defav) REPLACE_SV (GvAV (PL_defgv), c->defav);
273	if (c->defsv) REPLACE_SV (DEFSV , c->defsv);	318	if (c->defsv) REPLACE_SV (DEFSV , c->defsv);
274	if (c->errsv) REPLACE_SV (ERRSV , c->errsv);	319	if (c->errsv) REPLACE_SV (ERRSV , c->errsv);
275		320
…		…
302	save_state(pTHX_ Coro__State c, int flags)	347	save_state(pTHX_ Coro__State c, int flags)
303	{	348	{
304	{	349	{
305	dSP;	350	dSP;
306	I32 cxix = cxstack_ix;	351	I32 cxix = cxstack_ix;
		352	PERL_CONTEXT *ccstk = cxstack;
307	PERL_SI *top_si = PL_curstackinfo;	353	PERL_SI *top_si = PL_curstackinfo;
308	PERL_CONTEXT *ccstk = cxstack;
309		354
310	/*	355	/*
311	* the worst thing you can imagine happens first - we have to save	356	* the worst thing you can imagine happens first - we have to save
312	* (and reinitialize) all cv's in the whole callchain :(	357	* (and reinitialize) all cv's in the whole callchain :(
313	*/	358	*/
314		359
315	PUSHs (Nullsv);	360	PUSHs (Nullsv);
316	/* this loop was inspired by pp_caller */	361	/* this loop was inspired by pp_caller */
317	for (;;)	362	for (;;)
318	{	363	{
319	do	364	do
320	{	365	{
321	PERL_CONTEXT *cx = &ccstk[cxix--];	366	PERL_CONTEXT *cx = &ccstk[cxix--];
322		367
323	if (CxTYPE(cx) == CXt_SUB)	368	if (CxTYPE(cx) == CXt_SUB)
324	{	369	{
…		…
363	}	408	}
364		409
365	PUTBACK;	410	PUTBACK;
366	}	411	}
367		412
368	c->defav = flags & SAVE_DEFAV ? (AV *)SvREFCNT_inc (GvAV (PL_defgv)) : 0;	413	c->defav = flags & TRANSFER_SAVE_DEFAV ? (AV *)SvREFCNT_inc (GvAV (PL_defgv)) : 0;
369	c->defsv = flags & SAVE_DEFSV ? SvREFCNT_inc (DEFSV) : 0;	414	c->defsv = flags & TRANSFER_SAVE_DEFSV ? SvREFCNT_inc (DEFSV) : 0;
370	c->errsv = flags & SAVE_ERRSV ? SvREFCNT_inc (ERRSV) : 0;	415	c->errsv = flags & TRANSFER_SAVE_ERRSV ? SvREFCNT_inc (ERRSV) : 0;
		416
		417	/* I have not the slightest idea of why av_reify is necessary */
		418	/* but if it's missing the defav contents magically get replaced sometimes */
		419	if (c->defav)
		420	av_reify (c->defav);
371		421
372	c->dowarn = PL_dowarn;	422	c->dowarn = PL_dowarn;
373		423
374	c->curstackinfo = PL_curstackinfo;	424	c->curstackinfo = PL_curstackinfo;
375	c->curstack = PL_curstack;	425	c->curstack = PL_curstack;
…		…
394	c->savestack_max = PL_savestack_max;	444	c->savestack_max = PL_savestack_max;
395	c->retstack = PL_retstack;	445	c->retstack = PL_retstack;
396	c->retstack_ix = PL_retstack_ix;	446	c->retstack_ix = PL_retstack_ix;
397	c->retstack_max = PL_retstack_max;	447	c->retstack_max = PL_retstack_max;
398	c->curcop = PL_curcop;	448	c->curcop = PL_curcop;
		449	c->start_env = PL_start_env;
		450	c->top_env = PL_top_env;
		451	}
		452
		453	/*
		454	* allocate various perl stacks. This is an exact copy
		455	* of perl.c:init_stacks, except that it uses less memory
		456	* on the assumption that coroutines do not usually need
		457	* a lot of stackspace.
		458	*/
		459	STATIC void
		460	coro_init_stacks (pTHX)
		461	{
		462	PL_curstackinfo = new_stackinfo(96, 1024/sizeof(PERL_CONTEXT) - 1);
		463	PL_curstackinfo->si_type = PERLSI_MAIN;
		464	PL_curstack = PL_curstackinfo->si_stack;
		465	PL_mainstack = PL_curstack; /* remember in case we switch stacks */
		466
		467	PL_stack_base = AvARRAY(PL_curstack);
		468	PL_stack_sp = PL_stack_base;
		469	PL_stack_max = PL_stack_base + AvMAX(PL_curstack);
		470
		471	New(50,PL_tmps_stack,96,SV*);
		472	PL_tmps_floor = -1;
		473	PL_tmps_ix = -1;
		474	PL_tmps_max = 96;
		475
		476	New(54,PL_markstack,16,I32);
		477	PL_markstack_ptr = PL_markstack;
		478	PL_markstack_max = PL_markstack + 16;
		479
		480	SET_MARK_OFFSET;
		481
		482	New(54,PL_scopestack,16,I32);
		483	PL_scopestack_ix = 0;
		484	PL_scopestack_max = 16;
		485
		486	New(54,PL_savestack,96,ANY);
		487	PL_savestack_ix = 0;
		488	PL_savestack_max = 96;
		489
		490	New(54,PL_retstack,8,OP*);
		491	PL_retstack_ix = 0;
		492	PL_retstack_max = 8;
399	}	493	}
400		494
401	/*	495	/*
402	* destroy the stacks, the callchain etc...	496	* destroy the stacks, the callchain etc...
403	* still there is a memleak of 128 bytes...	497	* still there is a memleak of 128 bytes...
…		…
439	Safefree(PL_scopestack);	533	Safefree(PL_scopestack);
440	Safefree(PL_savestack);	534	Safefree(PL_savestack);
441	Safefree(PL_retstack);	535	Safefree(PL_retstack);
442	}	536	}
443		537
		538	static void
		539	allocate_stack (Coro__State ctx, int alloc)
		540	{
		541	coro_stack *stack;
		542
		543	New (0, stack, 1, coro_stack);
		544
		545	stack->refcnt = 1;
		546	stack->usecnt = 1;
		547	stack->gencnt = ctx->gencnt = 0;
		548	if (alloc)
		549	{
		550	#ifdef HAVE_MMAP
		551	stack->ssize = 128 * 1024 * sizeof (long); /* mmap should do allocate-on-use */
		552	stack->sptr = mmap (0, stack->ssize, PROT_EXEC\|PROT_READ\|PROT_WRITE, MAP_PRIVATE\|MAP_ANON, 0, 0);
		553	if (stack->sptr == (void *)-1)
		554	#endif
		555	{
		556	/FIXME//D//* reasonable stack size! */
		557	stack->ssize = -4096 * sizeof (long);
		558	New (0, stack->sptr, 4096, long);
		559	}
		560	}
		561	else
		562	stack->sptr = 0;
		563
		564	ctx->stack = stack;
		565	}
		566
		567	static void
		568	deallocate_stack (Coro__State ctx)
		569	{
		570	coro_stack *stack = ctx->stack;
		571
		572	ctx->stack = 0;
		573
		574	if (stack)
		575	{
		576	if (!--stack->refcnt)
		577	{
		578	#ifdef HAVE_MMAP
		579	if (stack->ssize > 0 && stack->sptr)
		580	munmap (stack->sptr, stack->ssize);
		581	else
		582	#else
		583	Safefree (stack->sptr);
		584	#endif
		585	Safefree (stack);
		586	}
		587	else if (ctx->gencnt == stack->gencnt)
		588	--stack->usecnt;
		589	}
		590	}
		591
		592	static void
		593	setup_coro (void *arg)
		594	{
		595	/*
		596	* emulate part of the perl startup here.
		597	*/
		598	dSP;
		599	Coro__State ctx = (Coro__State)arg;
		600	SV sub_init = (SV)get_cv(SUB_INIT, FALSE);
		601
		602	coro_init_stacks (aTHX);
		603	JMPENV_BOOTSTRAP;
		604	SPAGAIN;
		605
		606	/PL_curcop = 0;/
		607	SvREFCNT_dec (GvAV (PL_defgv));
		608	GvAV (PL_defgv) = ctx->args;
		609
		610	if (ctx->stack)
		611	{
		612	ctx->cursp = 0;
		613
		614	PUSHMARK(SP);
		615	PUTBACK;
		616	(void) call_sv (sub_init, G_VOID\|G_NOARGS);
		617	croak ("FATAL: CCTXT coroutine returned!");
		618	}
		619	else
		620	{
		621	UNOP myop;
		622
		623	PL_op = (OP *)&myop;
		624
		625	Zero(&myop, 1, UNOP);
		626	myop.op_next = Nullop;
		627	myop.op_flags = OPf_WANT_VOID;
		628
		629	PUSHMARK(SP);
		630	XPUSHs (sub_init);
		631	/*
		632	* the next line is slightly wrong, as PL_op->op_next
		633	* is actually being executed so we skip the first op.
		634	* that doesn't matter, though, since it is only
		635	* pp_nextstate and we never return...
		636	* ah yes, and I don't care anyways ;)
		637	*/
		638	PUTBACK;
		639	PL_op = pp_entersub();
		640	SPAGAIN;
		641
		642	ENTER; /* necessary e.g. for dounwind */
		643	}
		644	}
		645
		646	static void
		647	continue_coro (void *arg)
		648	{
		649	/*
		650	* this is a _very_ stripped down perl interpreter ;)
		651	*/
		652	Coro__State ctx = (Coro__State)arg;
		653
		654	ctx->cursp = 0;
		655	PL_op = PL_op->op_next;
		656	CALLRUNOPS(aTHX);
		657	/NORETURN/
		658	abort ();
		659	}
		660
444	STATIC void	661	STATIC void
445	transfer(pTHX_ struct coro prev, struct coro next, int flags)	662	transfer(pTHX_ struct coro prev, struct coro next, int flags)
446	{	663	{
447	dSP;	664	dSP;
		665	dSTACKLEVEL;
448		666
449	if (prev != next)	667	if (prev != next)
450	{	668	{
451	/*
452	* this could be done in newprocess which would lead to
453	* extremely elegant and fast (just SAVE/LOAD)
454	* code here, but lazy allocation of stacks has also
455	* some virtues and the overhead of the if() is nil.
456	*/
457	if (next->mainstack)	669	if (next->mainstack)
458	{	670	{
459	SAVE (prev, flags);	671	SAVE (prev, flags);
460	LOAD (next);	672	LOAD (next);
		673
461	/* mark this state as in-use */	674	/* mark this state as in-use */
462	next->mainstack = 0;	675	next->mainstack = 0;
463	next->tmps_ix = -2;	676	next->tmps_ix = -2;
		677
		678	/* stacklevel changed? if yes, grab the stack for us! */
		679	if (flags & TRANSFER_SAVE_CCTXT)
		680	{
		681	if (!prev->stack)
		682	allocate_stack (prev, 0);
		683	else if (prev->cursp != stacklevel
		684	&& prev->stack->usecnt > 1)
		685	{
		686	prev->gencnt = ++prev->stack->gencnt;
		687	prev->stack->usecnt = 1;
		688	}
		689
		690	/* has our stack been invalidated? */
		691	if (next->stack && next->stack->gencnt != next->gencnt)
		692	{
		693	deallocate_stack (next);
		694	allocate_stack (next, 1);
		695	coro_create (&(next->stack->cctx),
		696	continue_coro, (void *)next,
		697	next->stack->sptr, labs (next->stack->ssize));
		698	}
		699
		700	coro_transfer (&(prev->stack->cctx), &(next->stack->cctx));
		701	}
		702
464	}	703	}
465	else if (next->tmps_ix == -2)	704	else if (next->tmps_ix == -2)
466	{
467	croak ("tried to transfer to running coroutine");	705	croak ("tried to transfer to running coroutine");
468	}
469	else	706	else
470	{	707	{
471	/*
472	* emulate part of the perl startup here.
473	*/
474	UNOP myop;
475
476	SAVE (prev, -1); /* first get rid of the old state */	708	SAVE (prev, -1); /* first get rid of the old state */
477		709
478	init_stacks (); /* from perl.c */	710	if (flags & TRANSFER_SAVE_CCTXT)
479	SPAGAIN;
480
481	PL_op = (OP *)&myop;
482	/PL_curcop = 0;/
483	SvREFCNT_dec (GvAV (PL_defgv));
484	GvAV (PL_defgv) = next->args;
485
486	Zero(&myop, 1, UNOP);
487	myop.op_next = Nullop;
488	myop.op_flags = OPf_WANT_VOID;
489
490	PUSHMARK(SP);
491	XPUSHs ((SV*)get_cv(SUB_INIT, TRUE));
492	/*
493	* the next line is slightly wrong, as PL_op->op_next
494	* is actually being executed so we skip the first op.
495	* that doesn't matter, though, since it is only
496	* pp_nextstate and we never return...
497	* ah yes, and I don't care anyways ;)
498	*/	711	{
499	PUTBACK;	712	if (!prev->stack)
500	PL_op = pp_entersub(aTHX);	713	allocate_stack (prev, 0);
501	SPAGAIN;
502		714
503	ENTER; /* necessary e.g. for dounwind */	715	if (prev->stack->sptr && flags & TRANSFER_LAZY_STACK)
		716	{
		717	setup_coro (next);
		718
		719	prev->stack->refcnt++;
		720	prev->stack->usecnt++;
		721	next->stack = prev->stack;
		722	next->gencnt = prev->gencnt;
		723	}
		724	else
		725	{
		726	allocate_stack (next, 1);
		727	coro_create (&(next->stack->cctx),
		728	setup_coro, (void *)next,
		729	next->stack->sptr, labs (next->stack->ssize));
		730	coro_transfer (&(prev->stack->cctx), &(next->stack->cctx));
		731	}
		732	}
		733	else
		734	setup_coro (next);
504	}	735	}
505	}	736	}
		737
		738	next->cursp = stacklevel;
506	}	739	}
507		740
508	MODULE = Coro::State PACKAGE = Coro::State	741	MODULE = Coro::State PACKAGE = Coro::State
509		742
510	PROTOTYPES: ENABLE	743	PROTOTYPES: ENABLE
511		744
512	BOOT:	745	BOOT:
		746	{ /* {} necessary for stoopid perl-5.6.x */
		747	ucoro_state_sv = newSVpv (UCORO_STATE, sizeof(UCORO_STATE) - 1);
		748	PERL_HASH(ucoro_state_hash, UCORO_STATE, sizeof(UCORO_STATE) - 1);
513	HV * stash = gv_stashpvn("Coro::State", 10, TRUE);	749	coro_state_stash = gv_stashpv ("Coro::State", TRUE);
514		750
515	newCONSTSUB (stash, "SAVE_DEFAV", newSViv (SAVE_DEFAV));	751	newCONSTSUB (coro_state_stash, "SAVE_DEFAV", newSViv (TRANSFER_SAVE_DEFAV));
516	newCONSTSUB (stash, "SAVE_DEFSV", newSViv (SAVE_DEFSV));	752	newCONSTSUB (coro_state_stash, "SAVE_DEFSV", newSViv (TRANSFER_SAVE_DEFSV));
517	newCONSTSUB (stash, "SAVE_ERRSV", newSViv (SAVE_ERRSV));	753	newCONSTSUB (coro_state_stash, "SAVE_ERRSV", newSViv (TRANSFER_SAVE_ERRSV));
		754	newCONSTSUB (coro_state_stash, "SAVE_CCTXT", newSViv (TRANSFER_SAVE_CCTXT));
518		755
519	if (!padlist_cache)	756	if (!padlist_cache)
520	padlist_cache = newHV ();	757	padlist_cache = newHV ();
		758
		759	main_mainstack = PL_mainstack;
		760	}
521		761
522	Coro::State	762	Coro::State
523	_newprocess(args)	763	_newprocess(args)
524	SV * args	764	SV * args
525	PROTOTYPE: $	765	PROTOTYPE: $
…		…
529	if (!SvROK (args) \|\| SvTYPE (SvRV (args)) != SVt_PVAV)	769	if (!SvROK (args) \|\| SvTYPE (SvRV (args)) != SVt_PVAV)
530	croak ("Coro::State::_newprocess expects an arrayref");	770	croak ("Coro::State::_newprocess expects an arrayref");
531		771
532	New (0, coro, 1, struct coro);	772	New (0, coro, 1, struct coro);
533		773
		774	coro->args = (AV *)SvREFCNT_inc (SvRV (args));
534	coro->mainstack = 0; /* actual work is done inside transfer */	775	coro->mainstack = 0; /* actual work is done inside transfer */
535	coro->args = (AV *)SvREFCNT_inc (SvRV (args));	776	coro->stack = 0;
536		777
537	RETVAL = coro;	778	RETVAL = coro;
538	OUTPUT:	779	OUTPUT:
539	RETVAL	780	RETVAL
540		781
541	void	782	void
542	transfer(prev, next, flags = SAVE_DEFAV)	783	transfer(prev, next, flags = TRANSFER_SAVE_ALL \| TRANSFER_LAZY_STACK)
543	Coro::State_or_hashref prev	784	Coro::State_or_hashref prev
544	Coro::State_or_hashref next	785	Coro::State_or_hashref next
545	int flags	786	int flags
546	PROTOTYPE: @	787	PROTOTYPE: @
547	CODE:	788	CODE:
548
549	transfer (aTHX_ prev, next, flags);	789	transfer (aTHX_ prev, next, flags);
550		790
551	void	791	void
552	DESTROY(coro)	792	DESTROY(coro)
553	Coro::State coro	793	Coro::State coro
554	CODE:	794	CODE:
555		795
556	if (coro->mainstack)	796	if (coro->mainstack && coro->mainstack != main_mainstack)
557	{	797	{
558	struct coro temp;	798	struct coro temp;
559		799
560	SAVE(aTHX_ (&temp), SAVE_ALL);	800	SAVE(aTHX_ (&temp), TRANSFER_SAVE_ALL);
561	LOAD(aTHX_ coro);	801	LOAD(aTHX_ coro);
562		802
563	destroy_stacks ();	803	destroy_stacks (aTHX);
564		804
565	LOAD((&temp)); /* this will get rid of defsv etc.. */	805	LOAD((&temp)); /* this will get rid of defsv etc.. */
		806
		807	coro->mainstack = 0;
566	}	808	}
		809
		810	deallocate_stack (coro);
567		811
568	Safefree (coro);	812	Safefree (coro);
569		813
570	void	814	void
571	flush()	815	flush()
…		…
574	flush_padlist_cache ();	818	flush_padlist_cache ();
575	#endif	819	#endif
576		820
577	MODULE = Coro::State PACKAGE = Coro::Cont	821	MODULE = Coro::State PACKAGE = Coro::Cont
578		822
579	# this is dirty and should be in it's own .xs	823	# this is slightly dirty
580		824
581	void	825	void
582	result(...)	826	yield(...)
583	PROTOTYPE: @	827	PROTOTYPE: @
584	CODE:	828	CODE:
585	static SV *returnstk;	829	static SV *returnstk;
586	SV *sv;	830	SV *sv;
587	AV *defav = GvAV (PL_defgv);	831	AV *defav = GvAV (PL_defgv);
588	struct coro prev, next;	832	struct coro prev, next;
589		833
590	if (!returnstk)	834	if (!returnstk)
591	returnstk = SvRV (get_sv ("Coro::Cont::return", FALSE));	835	returnstk = SvRV (get_sv ("Coro::Cont::return", FALSE));
592		836
593	/* set up @_ */	837	/* set up @_ -- ugly */
594	av_clear (defav);	838	av_clear (defav);
595	av_fill (defav, items - 1);	839	av_fill (defav, items - 1);
596	while (items--)	840	while (items--)
597	av_store (defav, items, SvREFCNT_inc (ST(items)));	841	av_store (defav, items, SvREFCNT_inc (ST(items)));
598		842
599	mg_get (returnstk); /* isn't documentation wrong for mg_get? */	843	mg_get (returnstk); /* isn't documentation wrong for mg_get? */
600	sv = av_pop ((AV *)SvRV (returnstk));	844	sv = av_pop ((AV *)SvRV (returnstk));
601	prev = (struct coro )SvIV ((SV)SvRV (av_fetch ((AV )SvRV (sv), 0, 0)));	845	prev = (struct coro )SvIV ((SV)SvRV (av_fetch ((AV )SvRV (sv), 0, 0)));
602	next = (struct coro )SvIV ((SV)SvRV (av_fetch ((AV )SvRV (sv), 1, 0)));	846	next = (struct coro )SvIV ((SV)SvRV (av_fetch ((AV )SvRV (sv), 1, 0)));
603	SvREFCNT_dec (sv);	847	SvREFCNT_dec (sv);
		848
604	transfer(prev, next, 0);	849	transfer(aTHX_ prev, next, 0);
605		850

Diff Legend

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

Comparing Coro/Coro/State.xs (file contents): Revision 1.8 by root, Thu Jul 19 04:13:22 2001 UTC vs. Revision 1.15 by root, Wed Jul 25 04:14:38 2001 UTC

Diff Legend

Comparing Coro/Coro/State.xs (file contents):
Revision 1.8 by root, Thu Jul 19 04:13:22 2001 UTC vs.
Revision 1.15 by root, Wed Jul 25 04:14:38 2001 UTC