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

Comparing Coro/Coro/State.xs (file contents):
Revision 1.14 by root, Mon Jul 23 23:48:05 2001 UTC vs.
Revision 1.31 by root, Sun Aug 26 16:36:08 2001 UTC

…		…
2	#include "perl.h"	2	#include "perl.h"
3	#include "XSUB.h"	3	#include "XSUB.h"
4		4
5	#include "libcoro/coro.c"	5	#include "libcoro/coro.c"
6		6
		7	#include <signal.h>
		8
7	#ifdef HAVE_MMAP	9	#ifdef HAVE_MMAP
8	# include <unistd.h>	10	# include <unistd.h>
9	# include <sys/mman.h>	11	# include <sys/mman.h>
		12	# ifndef MAP_ANON
		13	# ifdef MAP_ANONYMOUS
		14	# define MAP_ANON MAP_ANONYMOUS
		15	# else
		16	# undef HAVE_MMAP
		17	# endif
		18	# endif
10	#endif	19	#endif
11		20
12	#define MAY_FLUSH /* increases codesize */	21	#define MAY_FLUSH /* increases codesize and is rarely used */
13
14	#define TRANSFER_SAVE_DEFAV 0x00000001
15	#define TRANSFER_SAVE_DEFSV 0x00000002
16	#define TRANSFER_SAVE_ERRSV 0x00000004
17	#define TRANSFER_SAVE_CCTXT 0x00000008
18
19	#define TRANSFER_SAVE_ALL -1
20		22
21	#define SUB_INIT "Coro::State::initialize"	23	#define SUB_INIT "Coro::State::initialize"
22	#define UCORO_STATE "_coro_state"	24	#define UCORO_STATE "_coro_state"
23		25
		26	/* The next macro should declare a variable stacklevel that contains and approximation
		27	* to the current C stack pointer. Its property is that it changes with each call
		28	* and should be unique. */
		29	#define dSTACKLEVEL void *stacklevel = &stacklevel
		30
		31	#define labs(l) ((l) >= 0 ? (l) : -(l))
		32
		33	#include "CoroAPI.h"
		34
		35	static struct CoroAPI coroapi;
		36
		37	/* this is actually not only the c stack but also c registers etc... */
		38	typedef struct {
		39	int refcnt; /* pointer reference counter */
		40	int usecnt; /* shared by how many coroutines */
		41	int gencnt; /* generation counter */
		42
		43	coro_context cctx;
		44
		45	void *sptr;
		46	long ssize; /* positive == mmap, otherwise malloc */
		47	} coro_stack;
		48
24	struct coro {	49	struct coro {
25	/* the optional C context */	50	/* the optional C context */
26	coro_context cctx;	51	coro_stack *stack;
27	void *sptr;	52	void *cursp;
28	long ssize;	53	int gencnt;
29		54
30	/* optionally saved, might be zero */	55	/* optionally saved, might be zero */
31	AV *defav;	56	AV *defav;
32	SV *defsv;	57	SV *defsv;
33	SV *errsv;	58	SV *errsv;
34		59
35	/* saved global state not related to stacks */	60	/* saved global state not related to stacks */
36	U8 dowarn;	61	U8 dowarn;
		62	I32 in_eval;
37		63
38	/* the stacks and related info (callchain etc..) */	64	/* the stacks and related info (callchain etc..) */
39	PERL_SI *curstackinfo;	65	PERL_SI *curstackinfo;
40	AV *curstack;	66	AV *curstack;
41	AV *mainstack;	67	AV *mainstack;
…		…
59	I32 savestack_max;	85	I32 savestack_max;
60	OP **retstack;	86	OP **retstack;
61	I32 retstack_ix;	87	I32 retstack_ix;
62	I32 retstack_max;	88	I32 retstack_max;
63	COP *curcop;	89	COP *curcop;
64	JMPENV start_env;
65	JMPENV *top_env;	90	JMPENV *top_env;
66		91
67	/* data associated with this coroutine (initial args) */	92	/* data associated with this coroutine (initial args) */
68	AV *args;	93	AV *args;
69	};	94	};
…		…
170		195
171	return newpadlist;	196	return newpadlist;
172	}	197	}
173		198
174	#ifdef MAY_FLUSH	199	#ifdef MAY_FLUSH
175	STATIC AV *	200	STATIC void
176	free_padlist (AV *padlist)	201	free_padlist (AV *padlist)
177	{	202	{
178	/* may be during global destruction */	203	/* may be during global destruction */
179	if (SvREFCNT(padlist))	204	if (SvREFCNT(padlist))
180	{	205	{
…		…
245	#endif	270	#endif
246		271
247	#define SB do {	272	#define SB do {
248	#define SE } while (0)	273	#define SE } while (0)
249		274
250	#define LOAD(state) SB load_state(aTHX_ (state)); SPAGAIN; SE	275	#define LOAD(state) load_state(aTHX_ (state));
251	#define SAVE(state,flags) SB PUTBACK; save_state(aTHX_ (state),(flags)); SE	276	#define SAVE(state,flags) save_state(aTHX_ (state),(flags));
252		277
253	#define REPLACE_SV(sv,val) SB SvREFCNT_dec(sv); (sv) = (val); SE	278	#define REPLACE_SV(sv,val) SB SvREFCNT_dec(sv); (sv) = (val); SE
254		279
255	static void	280	static void
256	load_state(pTHX_ Coro__State c)	281	load_state(pTHX_ Coro__State c)
257	{	282	{
258	PL_dowarn = c->dowarn;	283	PL_dowarn = c->dowarn;
		284	PL_in_eval = c->in_eval;
259		285
260	PL_curstackinfo = c->curstackinfo;	286	PL_curstackinfo = c->curstackinfo;
261	PL_curstack = c->curstack;	287	PL_curstack = c->curstack;
262	PL_mainstack = c->mainstack;	288	PL_mainstack = c->mainstack;
263	PL_stack_sp = c->stack_sp;	289	PL_stack_sp = c->stack_sp;
…		…
280	PL_savestack_max = c->savestack_max;	306	PL_savestack_max = c->savestack_max;
281	PL_retstack = c->retstack;	307	PL_retstack = c->retstack;
282	PL_retstack_ix = c->retstack_ix;	308	PL_retstack_ix = c->retstack_ix;
283	PL_retstack_max = c->retstack_max;	309	PL_retstack_max = c->retstack_max;
284	PL_curcop = c->curcop;	310	PL_curcop = c->curcop;
285	PL_start_env = c->start_env;
286	PL_top_env = c->top_env;	311	PL_top_env = c->top_env;
287		312
288	if (c->defav) REPLACE_SV (GvAV (PL_defgv), c->defav);	313	if (c->defav) REPLACE_SV (GvAV (PL_defgv), c->defav);
289	if (c->defsv) REPLACE_SV (DEFSV , c->defsv);	314	if (c->defsv) REPLACE_SV (DEFSV , c->defsv);
290	if (c->errsv) REPLACE_SV (ERRSV , c->errsv);	315	if (c->errsv) REPLACE_SV (ERRSV , c->errsv);
…		…
330		355
331	PUSHs (Nullsv);	356	PUSHs (Nullsv);
332	/* this loop was inspired by pp_caller */	357	/* this loop was inspired by pp_caller */
333	for (;;)	358	for (;;)
334	{	359	{
335	do	360	while (cxix >= 0)
336	{	361	{
337	PERL_CONTEXT *cx = &ccstk[cxix--];	362	PERL_CONTEXT *cx = &ccstk[cxix--];
338		363
339	if (CxTYPE(cx) == CXt_SUB)	364	if (CxTYPE(cx) == CXt_SUB)
340	{	365	{
…		…
366	/* I never used formats, so how should I know how these are implemented? */	391	/* I never used formats, so how should I know how these are implemented? */
367	/* my bold guess is as a simple, plain sub... */	392	/* my bold guess is as a simple, plain sub... */
368	croak ("CXt_FORMAT not yet handled. Don't switch coroutines from within formats");	393	croak ("CXt_FORMAT not yet handled. Don't switch coroutines from within formats");
369	}	394	}
370	}	395	}
371	while (cxix >= 0);
372		396
373	if (top_si->si_type == PERLSI_MAIN)	397	if (top_si->si_type == PERLSI_MAIN)
374	break;	398	break;
375		399
376	top_si = top_si->si_prev;	400	top_si = top_si->si_prev;
…		…
383		407
384	c->defav = flags & TRANSFER_SAVE_DEFAV ? (AV *)SvREFCNT_inc (GvAV (PL_defgv)) : 0;	408	c->defav = flags & TRANSFER_SAVE_DEFAV ? (AV *)SvREFCNT_inc (GvAV (PL_defgv)) : 0;
385	c->defsv = flags & TRANSFER_SAVE_DEFSV ? SvREFCNT_inc (DEFSV) : 0;	409	c->defsv = flags & TRANSFER_SAVE_DEFSV ? SvREFCNT_inc (DEFSV) : 0;
386	c->errsv = flags & TRANSFER_SAVE_ERRSV ? SvREFCNT_inc (ERRSV) : 0;	410	c->errsv = flags & TRANSFER_SAVE_ERRSV ? SvREFCNT_inc (ERRSV) : 0;
387		411
388	/* I have not the slightest idea of why av_reify is necessary */
389	/* but if it's missing the defav contents magically get replaced sometimes */
390	if (c->defav)
391	av_reify (c->defav);
392
393	c->dowarn = PL_dowarn;	412	c->dowarn = PL_dowarn;
		413	c->in_eval = PL_in_eval;
394		414
395	c->curstackinfo = PL_curstackinfo;	415	c->curstackinfo = PL_curstackinfo;
396	c->curstack = PL_curstack;	416	c->curstack = PL_curstack;
397	c->mainstack = PL_mainstack;	417	c->mainstack = PL_mainstack;
398	c->stack_sp = PL_stack_sp;	418	c->stack_sp = PL_stack_sp;
…		…
415	c->savestack_max = PL_savestack_max;	435	c->savestack_max = PL_savestack_max;
416	c->retstack = PL_retstack;	436	c->retstack = PL_retstack;
417	c->retstack_ix = PL_retstack_ix;	437	c->retstack_ix = PL_retstack_ix;
418	c->retstack_max = PL_retstack_max;	438	c->retstack_max = PL_retstack_max;
419	c->curcop = PL_curcop;	439	c->curcop = PL_curcop;
420	c->start_env = PL_start_env;
421	c->top_env = PL_top_env;	440	c->top_env = PL_top_env;
422	}	441	}
423		442
424	/*	443	/*
425	* allocate various perl stacks. This is an exact copy	444	* allocate various perl stacks. This is an exact copy
…		…
437		456
438	PL_stack_base = AvARRAY(PL_curstack);	457	PL_stack_base = AvARRAY(PL_curstack);
439	PL_stack_sp = PL_stack_base;	458	PL_stack_sp = PL_stack_base;
440	PL_stack_max = PL_stack_base + AvMAX(PL_curstack);	459	PL_stack_max = PL_stack_base + AvMAX(PL_curstack);
441		460
442	New(50,PL_tmps_stack,64,SV*);	461	New(50,PL_tmps_stack,96,SV*);
443	PL_tmps_floor = -1;	462	PL_tmps_floor = -1;
444	PL_tmps_ix = -1;	463	PL_tmps_ix = -1;
445	PL_tmps_max = 64;	464	PL_tmps_max = 96;
446		465
447	New(54,PL_markstack,12,I32);	466	New(54,PL_markstack,16,I32);
448	PL_markstack_ptr = PL_markstack;	467	PL_markstack_ptr = PL_markstack;
449	PL_markstack_max = PL_markstack + 12;	468	PL_markstack_max = PL_markstack + 16;
450		469
451	SET_MARK_OFFSET;	470	SET_MARK_OFFSET;
452		471
453	New(54,PL_scopestack,12,I32);	472	New(54,PL_scopestack,16,I32);
454	PL_scopestack_ix = 0;	473	PL_scopestack_ix = 0;
455	PL_scopestack_max = 12;	474	PL_scopestack_max = 16;
456		475
457	New(54,PL_savestack,64,ANY);	476	New(54,PL_savestack,96,ANY);
458	PL_savestack_ix = 0;	477	PL_savestack_ix = 0;
459	PL_savestack_max = 64;	478	PL_savestack_max = 96;
460		479
461	New(54,PL_retstack,8,OP*);	480	New(54,PL_retstack,8,OP*);
462	PL_retstack_ix = 0;	481	PL_retstack_ix = 0;
463	PL_retstack_max = 8;	482	PL_retstack_max = 8;
464	}	483	}
…		…
468	* still there is a memleak of 128 bytes...	487	* still there is a memleak of 128 bytes...
469	*/	488	*/
470	STATIC void	489	STATIC void
471	destroy_stacks(pTHX)	490	destroy_stacks(pTHX)
472	{	491	{
		492	int destruct = PL_main_cv != Nullcv;
		493
		494	if (destruct)
		495	{
473	/* is this ugly, I ask? */	496	/* is this ugly, I ask? */
474	while (PL_scopestack_ix)	497	while (PL_scopestack_ix)
475	LEAVE;	498	LEAVE;
476		499
477	/* sure it is, but more important: is it correct?? :/ */	500	/* sure it is, but more important: is it correct?? :/ */
478	while (PL_tmps_ix > PL_tmps_floor) /* should only ever be one iteration */	501	while (PL_tmps_ix > PL_tmps_floor) /* should only ever be one iteration */
479	FREETMPS;	502	FREETMPS;
		503	}
480		504
481	while (PL_curstackinfo->si_next)	505	while (PL_curstackinfo->si_next)
482	PL_curstackinfo = PL_curstackinfo->si_next;	506	PL_curstackinfo = PL_curstackinfo->si_next;
483		507
484	while (PL_curstackinfo)	508	while (PL_curstackinfo)
…		…
489	dSP;	513	dSP;
490	SWITCHSTACK (PL_curstack, PL_curstackinfo->si_stack);	514	SWITCHSTACK (PL_curstack, PL_curstackinfo->si_stack);
491	PUTBACK; /* possibly superfluous */	515	PUTBACK; /* possibly superfluous */
492	}	516	}
493		517
		518	if (destruct)
		519	{
494	dounwind(-1);	520	dounwind(-1);
495
496	SvREFCNT_dec(PL_curstackinfo->si_stack);	521	SvREFCNT_dec(PL_curstackinfo->si_stack);
		522	}
		523
497	Safefree(PL_curstackinfo->si_cxstack);	524	Safefree(PL_curstackinfo->si_cxstack);
498	Safefree(PL_curstackinfo);	525	Safefree(PL_curstackinfo);
499	PL_curstackinfo = p;	526	PL_curstackinfo = p;
500	}	527	}
501		528
…		…
505	Safefree(PL_savestack);	532	Safefree(PL_savestack);
506	Safefree(PL_retstack);	533	Safefree(PL_retstack);
507	}	534	}
508		535
509	static void	536	static void
510	allocate_stack (Coro__State ctx)	537	allocate_stack (Coro__State ctx, int alloc)
511	{	538	{
		539	coro_stack *stack;
		540
		541	New (0, stack, 1, coro_stack);
		542
		543	stack->refcnt = 1;
		544	stack->usecnt = 1;
		545	stack->gencnt = ctx->gencnt = 0;
		546	if (alloc)
		547	{
512	#ifdef HAVE_MMAP	548	#ifdef HAVE_MMAP
513	ctx->ssize = 128 * 1024 * sizeof (long); /* mmap should do allocate-on-use */	549	stack->ssize = 128 * 1024 * sizeof (long); /* mmap should do allocate-on-write for us */
514	ctx->sptr = mmap (0, ctx->ssize, PROT_EXEC\|PROT_READ\|PROT_WRITE, MAP_PRIVATE\|MAP_ANON, 0, 0);	550	stack->sptr = mmap (0, stack->ssize, PROT_EXEC\|PROT_READ\|PROT_WRITE, MAP_PRIVATE\|MAP_ANON, 0, 0);
515	if (ctx->sptr == (void *)-1)	551	if (stack->sptr == (void *)-1)
516	#endif	552	#endif
517	{	553	{
518	/FIXME//D//* reasonable stack size! */	554	/FIXME//D//* reasonable stack size! */
519	ctx->ssize = 4096 * sizeof (long);	555	stack->ssize = -4096 * sizeof (long);
520	New (0, ctx->sptr, 4096, long);	556	New (0, stack->sptr, 4096, long);
		557	}
521	}	558	}
		559	else
		560	stack->sptr = 0;
		561
		562	ctx->stack = stack;
522	}	563	}
523		564
524	static void	565	static void
525	deallocate_stack (Coro__State ctx)	566	deallocate_stack (Coro__State ctx)
526	{	567	{
		568	coro_stack *stack = ctx->stack;
		569
		570	ctx->stack = 0;
		571
		572	if (stack)
		573	{
		574	if (!--stack->refcnt)
		575	{
527	#ifdef HAVE_MMAP	576	#ifdef HAVE_MMAP
528	munmap (ctx->sptr, ctx->ssize);	577	if (stack->ssize > 0 && stack->sptr)
		578	munmap (stack->sptr, stack->ssize);
		579	else
529	#else	580	#else
530	Safefree (ctx->sptr);	581	Safefree (stack->sptr);
531	#endif	582	#endif
		583	Safefree (stack);
		584	}
		585	else if (ctx->gencnt == stack->gencnt)
		586	--stack->usecnt;
		587	}
532	}	588	}
533		589
534	/* might go away together with optional SAVE_CCTXT */
535	static void	590	static void
536	setup_coro (void *arg)	591	setup_coro (void *arg)
537	{	592	{
538	/*	593	/*
539	* emulate part of the perl startup here.	594	* emulate part of the perl startup here.
…		…
541	dSP;	596	dSP;
542	Coro__State ctx = (Coro__State)arg;	597	Coro__State ctx = (Coro__State)arg;
543	SV sub_init = (SV)get_cv(SUB_INIT, FALSE);	598	SV sub_init = (SV)get_cv(SUB_INIT, FALSE);
544		599
545	coro_init_stacks (aTHX);	600	coro_init_stacks (aTHX);
546	JMPENV_BOOTSTRAP;
547	SPAGAIN;
548
549	/PL_curcop = 0;/	601	/PL_curcop = 0;/
		602	/PL_in_eval = PL_in_eval;/ /* inherit */
550	SvREFCNT_dec (GvAV (PL_defgv));	603	SvREFCNT_dec (GvAV (PL_defgv));
551	GvAV (PL_defgv) = ctx->args;	604	GvAV (PL_defgv) = ctx->args;
552		605
		606	SPAGAIN;
		607
553	if (ctx->sptr)	608	if (ctx->stack)
554	{	609	{
		610	ctx->cursp = 0;
		611
555	PUSHMARK(SP);	612	PUSHMARK(SP);
556	PUTBACK;	613	PUTBACK;
557	(void) call_sv (sub_init, G_VOID\|G_NOARGS);	614	(void) call_sv (sub_init, G_VOID\|G_NOARGS\|G_EVAL);
		615
		616	if (SvTRUE (ERRSV))
		617	croak (NULL);
		618	else
558	croak ("FATAL: CCTXT coroutine returned!");	619	croak ("FATAL: CCTXT coroutine returned!");
559	}	620	}
560	else	621	else
561	{	622	{
562	UNOP myop;	623	UNOP myop;
563		624
…		…
582		643
583	ENTER; /* necessary e.g. for dounwind */	644	ENTER; /* necessary e.g. for dounwind */
584	}	645	}
585	}	646	}
586		647
		648	static void
		649	continue_coro (void *arg)
		650	{
		651	/*
		652	* this is a _very_ stripped down perl interpreter ;)
		653	*/
		654	Coro__State ctx = (Coro__State)arg;
		655
		656	/FIXME//* must set up top_env here */
		657	ctx->cursp = 0;
		658	PL_op = PL_op->op_next;
		659	CALLRUNOPS(aTHX);
		660
		661	abort ();
		662	}
		663
587	STATIC void	664	STATIC void
588	transfer(pTHX_ struct coro prev, struct coro next, int flags)	665	transfer(pTHX_ struct coro prev, struct coro next, int flags)
589	{	666	{
590	dSP;	667	dSTACKLEVEL;
		668	static struct coro *xnext;
591		669
592	if (prev != next)	670	if (prev != next)
593	{	671	{
594	/*	672	xnext = next;
595	* this could be done in newprocess which would lead to	673
596	* extremely elegant and fast (basically just SAVE/LOAD)
597	* code here, but lazy allocation of stacks has also
598	* some virtues and the overhead of the if() is nil.
599	*/
600	if (next->mainstack)	674	if (next->mainstack)
601	{	675	{
602	SAVE (prev, flags);	676	SAVE (prev, flags);
603	LOAD (next);	677	LOAD (next);
604		678
605	/* mark this state as in-use */	679	/* mark this state as in-use */
606	next->mainstack = 0;	680	next->mainstack = 0;
607	next->tmps_ix = -2;	681	next->tmps_ix = -2;
608		682
		683	/* stacklevel changed? if yes, grab the stack for us! */
609	if (flags & TRANSFER_SAVE_CCTXT)	684	if (flags & TRANSFER_SAVE_CCTXT)
610	{	685	{
611	if (!next->ssize)
612	croak ("destination coroutine has no CCTXT (%p, %d)", next->sptr, next->ssize);
613
614	if (!prev->ssize)	686	if (!prev->stack)
615	prev->ssize = 1; /* mark cctx as valid ;) */	687	allocate_stack (prev, 0);
		688	else if (prev->cursp != stacklevel
		689	&& prev->stack->usecnt > 1)
		690	{
		691	prev->gencnt = ++prev->stack->gencnt;
		692	prev->stack->usecnt = 1;
		693	}
616		694
		695	/* has our stack been invalidated? */
		696	if (next->stack && next->stack->gencnt != next->gencnt)
		697	{
		698	deallocate_stack (next);
		699	allocate_stack (next, 1);
		700	coro_create (&(next->stack->cctx),
		701	continue_coro, (void *)next,
		702	next->stack->sptr, labs (next->stack->ssize));
		703	}
		704
617	coro_transfer (&(prev->cctx), &(next->cctx));	705	coro_transfer (&(prev->stack->cctx), &(next->stack->cctx));
		706	/* don't add any code here */
618	}	707	}
619		708
620	}	709	}
621	else if (next->tmps_ix == -2)	710	else if (next->tmps_ix == -2)
622	croak ("tried to transfer to running coroutine");	711	croak ("tried to transfer to running coroutine");
…		…
624	{	713	{
625	SAVE (prev, -1); /* first get rid of the old state */	714	SAVE (prev, -1); /* first get rid of the old state */
626		715
627	if (flags & TRANSFER_SAVE_CCTXT)	716	if (flags & TRANSFER_SAVE_CCTXT)
628	{	717	{
629	if (!next->ssize)	718	if (!prev->stack)
		719	allocate_stack (prev, 0);
		720
		721	if (prev->stack->sptr && flags & TRANSFER_LAZY_STACK)
630	{	722	{
		723	setup_coro (next);
		724
		725	prev->stack->refcnt++;
		726	prev->stack->usecnt++;
		727	next->stack = prev->stack;
		728	next->gencnt = prev->gencnt;
		729	}
		730	else
		731	{
631	allocate_stack (next);	732	allocate_stack (next, 1);
632	coro_create (&(next->cctx),	733	coro_create (&(next->stack->cctx),
633	setup_coro, (void *)next,	734	setup_coro, (void *)next,
634	next->sptr, next->ssize);	735	next->stack->sptr, labs (next->stack->ssize));
		736	coro_transfer (&(prev->stack->cctx), &(next->stack->cctx));
		737	/* don't add any code here */
635	}	738	}
636
637	if (!prev->ssize)
638	prev->ssize = 1; /* mark cctx as valid ;) */
639
640	coro_transfer (&(prev->cctx), &(next->cctx));
641	}	739	}
642	else	740	else
643	setup_coro (next);	741	setup_coro (next);
644	}	742	}
645	}	743	}
		744
		745	/*
		746	* xnext is now either prev or next, depending on wether
		747	* we switched the c stack or not. that's why i use a global
		748	* variable, that should become thread-specific at one point.
		749	*/
		750	xnext->cursp = stacklevel;
		751	}
		752
		753	static struct coro *
		754	sv_to_coro (SV arg, const char funcname, const char *varname)
		755	{
		756	if (SvROK(arg) && SvTYPE(SvRV(arg)) == SVt_PVHV)
		757	{
		758	HE he = hv_fetch_ent((HV )SvRV(arg), ucoro_state_sv, 0, ucoro_state_hash);
		759
		760	if (!he)
		761	croak ("%s() -- %s is a hashref but lacks the " UCORO_STATE " key", funcname, varname);
		762
		763	arg = HeVAL(he);
		764	}
		765
		766	/* must also be changed inside Coro::Cont::yield */
		767	if (SvROK(arg) && SvSTASH(SvRV(arg)) == coro_state_stash)
		768	return (struct coro ) SvIV((SV)SvRV(arg));
		769
		770	croak ("%s() -- %s is not (and contains not) a Coro::State object", funcname, varname);
		771	/NORETURN/
		772	}
		773
		774	static void
		775	api_transfer(pTHX_ SV prev, SV next, int flags)
		776	{
		777	transfer(aTHX_
		778	sv_to_coro (prev, "Coro::transfer", "prev"),
		779	sv_to_coro (next, "Coro::transfer", "next"),
		780	flags);
		781	}
		782
		783	/ Coro ******************************************************************/
		784
		785	#define PRIO_MAX 3
		786	#define PRIO_HIGH 1
		787	#define PRIO_NORMAL 0
		788	#define PRIO_LOW -1
		789	#define PRIO_IDLE -3
		790	#define PRIO_MIN -4
		791
		792	/* for Coro.pm */
		793	static GV coro_current, coro_idle;
		794	static AV *coro_ready[PRIO_MAX-PRIO_MIN+1];
		795	static int coro_nready;
		796
		797	static void
		798	coro_enq (SV *sv)
		799	{
		800	if (SvROK (sv))
		801	{
		802	SV *hv = SvRV (sv);
		803	if (SvTYPE (hv) == SVt_PVHV)
		804	{
		805	SV *xprio = hv_fetch ((HV )hv, "prio", 4, 0);
		806	int prio = xprio ? SvIV (*xprio) : PRIO_NORMAL;
		807
		808	prio = prio > PRIO_MAX ? PRIO_MAX
		809	: prio < PRIO_MIN ? PRIO_MIN
		810	: prio;
		811
		812	av_push (coro_ready [prio - PRIO_MIN], sv);
		813	coro_nready++;
		814
		815	return;
		816	}
		817	}
		818
		819	croak ("Coro::ready tried to enqueue something that is not a coroutine");
		820	}
		821
		822	static SV *
		823	coro_deq (int min_prio)
		824	{
		825	int prio = PRIO_MAX - PRIO_MIN;
		826
		827	min_prio -= PRIO_MIN;
		828	if (min_prio < 0)
		829	min_prio = 0;
		830
		831	for (prio = PRIO_MAX - PRIO_MIN + 1; --prio >= min_prio; )
		832	if (av_len (coro_ready[prio]) >= 0)
		833	{
		834	coro_nready--;
		835	return av_shift (coro_ready[prio]);
		836	}
		837
		838	return 0;
		839	}
		840
		841	static void
		842	api_ready (SV *coro)
		843	{
		844	coro_enq (SvREFCNT_inc (coro));
		845	}
		846
		847	static void
		848	api_schedule (int cede)
		849	{
		850	SV prev, next;
		851
		852	prev = GvSV (coro_current);
		853
		854	if (cede)
		855	coro_enq (SvREFCNT_inc (prev));
		856
		857	next = coro_deq (PRIO_MIN);
		858
		859	if (!next)
		860	next = SvREFCNT_inc (GvSV (coro_idle));
		861
		862	GvSV (coro_current) = SvREFCNT_inc (next);
		863	transfer (aTHX_
		864	sv_to_coro (prev, "Coro::schedule", "current coroutine"),
		865	sv_to_coro (next, "Coro::schedule", "next coroutine"),
		866	TRANSFER_SAVE_ALL \| TRANSFER_LAZY_STACK);
		867	SvREFCNT_dec (next);
		868	SvREFCNT_dec (prev);
646	}	869	}
647		870
648	MODULE = Coro::State PACKAGE = Coro::State	871	MODULE = Coro::State PACKAGE = Coro::State
649		872
650	PROTOTYPES: ENABLE	873	PROTOTYPES: ENABLE
…		…
662		885
663	if (!padlist_cache)	886	if (!padlist_cache)
664	padlist_cache = newHV ();	887	padlist_cache = newHV ();
665		888
666	main_mainstack = PL_mainstack;	889	main_mainstack = PL_mainstack;
		890
		891	coroapi.ver = CORO_API_VERSION;
		892	coroapi.transfer = api_transfer;
667	}	893	}
668		894
669	Coro::State	895	Coro::State
670	_newprocess(args)	896	_newprocess(args)
671	SV * args	897	SV * args
…		…
678		904
679	New (0, coro, 1, struct coro);	905	New (0, coro, 1, struct coro);
680		906
681	coro->args = (AV *)SvREFCNT_inc (SvRV (args));	907	coro->args = (AV *)SvREFCNT_inc (SvRV (args));
682	coro->mainstack = 0; /* actual work is done inside transfer */	908	coro->mainstack = 0; /* actual work is done inside transfer */
683	coro->sptr = 0;	909	coro->stack = 0;
684	coro->ssize = 0;
685		910
686	RETVAL = coro;	911	RETVAL = coro;
687	OUTPUT:	912	OUTPUT:
688	RETVAL	913	RETVAL
689		914
690	void	915	void
691	transfer(prev, next, flags = TRANSFER_SAVE_ALL)	916	transfer(prev, next, flags)
692	Coro::State_or_hashref prev	917	Coro::State_or_hashref prev
693	Coro::State_or_hashref next	918	Coro::State_or_hashref next
694	int flags	919	int flags
695	PROTOTYPE: @	920	PROTOTYPE: @
696	CODE:	921	CODE:
		922	PUTBACK;
697	transfer (aTHX_ prev, next, flags);	923	transfer (aTHX_ prev, next, flags);
		924	SPAGAIN;
698		925
699	void	926	void
700	DESTROY(coro)	927	DESTROY(coro)
701	Coro::State coro	928	Coro::State coro
702	CODE:	929	CODE:
703		930
704	if (coro->mainstack && coro->mainstack != main_mainstack)	931	if (coro->mainstack && coro->mainstack != main_mainstack)
705	{	932	{
706	struct coro temp;	933	struct coro temp;
707		934
		935	PUTBACK;
708	SAVE(aTHX_ (&temp), TRANSFER_SAVE_ALL);	936	SAVE(aTHX_ (&temp), TRANSFER_SAVE_ALL);
709	LOAD(aTHX_ coro);	937	LOAD(aTHX_ coro);
		938	SPAGAIN;
710		939
711	destroy_stacks (aTHX);	940	destroy_stacks (aTHX);
712		941
713	LOAD((&temp)); /* this will get rid of defsv etc.. */	942	LOAD((&temp)); /* this will get rid of defsv etc.. */
		943	SPAGAIN;
714		944
715	coro->mainstack = 0;	945	coro->mainstack = 0;
716	}	946	}
717		947
718	if (coro->sptr)
719	{
720	deallocate_stack (coro);	948	deallocate_stack (coro);
721	coro->sptr = 0;
722	}
723		949
724	Safefree (coro);	950	Safefree (coro);
725		951
726	void	952	void
727	flush()	953	flush()
728	CODE:	954	CODE:
729	#ifdef MAY_FLUSH	955	#ifdef MAY_FLUSH
730	flush_padlist_cache ();	956	flush_padlist_cache ();
731	#endif	957	#endif
732		958
		959	void
		960	_exit(code)
		961	int code
		962	PROTOTYPE: $
		963	CODE:
		964	#if defined(__GLIBC__) \|\| _POSIX_C_SOURCE
		965	_exit (code);
		966	#else
		967	signal (SIGTERM, SIG_DFL);
		968	raise (SIGTERM);
		969	exit (code);
		970	#endif
		971
733	MODULE = Coro::State PACKAGE = Coro::Cont	972	MODULE = Coro::State PACKAGE = Coro::Cont
734		973
735	# this is slightly dirty	974	# this is slightly dirty (should expose a c-level api)
736		975
737	void	976	void
738	yield(...)	977	yield(...)
739	PROTOTYPE: @	978	PROTOTYPE: @
740	CODE:	979	CODE:
…		…
758	next = (struct coro )SvIV ((SV)SvRV (av_fetch ((AV )SvRV (sv), 1, 0)));	997	next = (struct coro )SvIV ((SV)SvRV (av_fetch ((AV )SvRV (sv), 1, 0)));
759	SvREFCNT_dec (sv);	998	SvREFCNT_dec (sv);
760		999
761	transfer(aTHX_ prev, next, 0);	1000	transfer(aTHX_ prev, next, 0);
762		1001
		1002	MODULE = Coro::State PACKAGE = Coro
		1003
		1004	# this is slightly dirty (should expose a c-level api)
		1005
		1006	BOOT:
		1007	{
		1008	int i;
		1009	HV *stash = gv_stashpv ("Coro", TRUE);
		1010
		1011	newCONSTSUB (stash, "PRIO_MAX", newSViv (PRIO_MAX));
		1012	newCONSTSUB (stash, "PRIO_HIGH", newSViv (PRIO_HIGH));
		1013	newCONSTSUB (stash, "PRIO_NORMAL", newSViv (PRIO_NORMAL));
		1014	newCONSTSUB (stash, "PRIO_LOW", newSViv (PRIO_LOW));
		1015	newCONSTSUB (stash, "PRIO_IDLE", newSViv (PRIO_IDLE));
		1016	newCONSTSUB (stash, "PRIO_MIN", newSViv (PRIO_MIN));
		1017
		1018	coro_current = gv_fetchpv ("Coro::current", TRUE, SVt_PV);
		1019	coro_idle = gv_fetchpv ("Coro::idle" , TRUE, SVt_PV);
		1020
		1021	for (i = PRIO_MAX - PRIO_MIN + 1; i--; )
		1022	coro_ready[i] = newAV ();
		1023
		1024	{
		1025	SV *sv = perl_get_sv("Coro::API", 1);
		1026
		1027	coroapi.schedule = api_schedule;
		1028	coroapi.ready = api_ready;
		1029	coroapi.nready = &coro_nready;
		1030	coroapi.current = coro_current;
		1031
		1032	GCoroAPI = &coroapi;
		1033	sv_setiv(sv, (IV)&coroapi);
		1034	SvREADONLY_on(sv);
		1035	}
		1036	}
		1037
		1038	void
		1039	ready(self)
		1040	SV * self
		1041	CODE:
		1042	api_ready (self);
		1043
		1044	int
		1045	nready(...)
		1046	PROTOTYPE:
		1047	CODE:
		1048	RETVAL = coro_nready;
		1049	OUTPUT:
		1050	RETVAL
		1051
		1052	void
		1053	schedule(...)
		1054	PROTOTYPE:
		1055	ALIAS:
		1056	cede = 1
		1057	CODE:
		1058	api_schedule (ix);
		1059

Diff Legend

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

Comparing Coro/Coro/State.xs (file contents): Revision 1.14 by root, Mon Jul 23 23:48:05 2001 UTC vs. Revision 1.31 by root, Sun Aug 26 16:36:08 2001 UTC

Diff Legend

Comparing Coro/Coro/State.xs (file contents):
Revision 1.14 by root, Mon Jul 23 23:48:05 2001 UTC vs.
Revision 1.31 by root, Sun Aug 26 16:36:08 2001 UTC