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

Comparing Coro/Coro/State.xs (file contents):
Revision 1.21 by root, Sat Aug 11 19:59:19 2001 UTC vs.
Revision 1.32 by root, Sun Aug 26 17:01:54 2001 UTC

…		…
16	# undef HAVE_MMAP	16	# undef HAVE_MMAP
17	# endif	17	# endif
18	# endif	18	# endif
19	#endif	19	#endif
20		20
21	#define MAY_FLUSH /* increases codesize */	21	#define MAY_FLUSH /* increases codesize and is rarely used */
22
23	/* perl-related */
24	#define TRANSFER_SAVE_DEFAV 0x00000001
25	#define TRANSFER_SAVE_DEFSV 0x00000002
26	#define TRANSFER_SAVE_ERRSV 0x00000004
27	/* c-related */
28	#define TRANSFER_SAVE_CCTXT 0x00000008
29	#ifdef CORO_LAZY_STACK
30	# define TRANSFER_LAZY_STACK 0x00000010
31	#else
32	# define TRANSFER_LAZY_STACK 0x00000000
33	#endif
34
35	#define TRANSFER_SAVE_ALL (TRANSFER_SAVE_DEFAV\|TRANSFER_SAVE_DEFSV \
36	\|TRANSFER_SAVE_ERRSV\|TRANSFER_SAVE_CCTXT)
37		22
38	#define SUB_INIT "Coro::State::initialize"	23	#define SUB_INIT "Coro::State::initialize"
39	#define UCORO_STATE "_coro_state"	24	#define UCORO_STATE "_coro_state"
40		25
41	/* The next macro should delcare a variable stacklevel that contains and approximation	26	/* The next macro should declare a variable stacklevel that contains and approximation
42	* to the current C stack pointer. It's property is that it changes with each call	27	* to the current C stack pointer. Its property is that it changes with each call
43	* and should be unique. */	28	* and should be unique. */
44	#define dSTACKLEVEL void *stacklevel = &stacklevel	29	#define dSTACKLEVEL void *stacklevel = &stacklevel
45		30
46	#define labs(l) ((l) >= 0 ? (l) : -(l))	31	#define labs(l) ((l) >= 0 ? (l) : -(l))
		32
		33	#include "CoroAPI.h"
		34
		35	static struct CoroAPI coroapi;
47		36
48	/* this is actually not only the c stack but also c registers etc... */	37	/* this is actually not only the c stack but also c registers etc... */
49	typedef struct {	38	typedef struct {
50	int refcnt; /* pointer reference counter */	39	int refcnt; /* pointer reference counter */
51	int usecnt; /* shared by how many coroutines */	40	int usecnt; /* shared by how many coroutines */
…		…
111	static HV *coro_state_stash;	100	static HV *coro_state_stash;
112	static SV *ucoro_state_sv;	101	static SV *ucoro_state_sv;
113	static U32 ucoro_state_hash;	102	static U32 ucoro_state_hash;
114	static HV *padlist_cache;	103	static HV *padlist_cache;
115		104
116	/* for Coro.pm */
117	static GV coro_current, coro_idle;
118	static AV *coro_ready;
119
120	/* mostly copied from op.c:cv_clone2 */	105	/* mostly copied from op.c:cv_clone2 */
121	STATIC AV *	106	STATIC AV *
122	clone_padlist (AV *protopadlist)	107	clone_padlist (AV *protopadlist)
123	{	108	{
124	AV *av;	109	AV *av;
…		…
210		195
211	return newpadlist;	196	return newpadlist;
212	}	197	}
213		198
214	#ifdef MAY_FLUSH	199	#ifdef MAY_FLUSH
215	STATIC AV *	200	STATIC void
216	free_padlist (AV *padlist)	201	free_padlist (AV *padlist)
217	{	202	{
218	/* may be during global destruction */	203	/* may be during global destruction */
219	if (SvREFCNT(padlist))	204	if (SvREFCNT(padlist))
220	{	205	{
…		…
285	#endif	270	#endif
286		271
287	#define SB do {	272	#define SB do {
288	#define SE } while (0)	273	#define SE } while (0)
289		274
290	#define LOAD(state) SB load_state(aTHX_ (state)); SPAGAIN; SE	275	#define LOAD(state) load_state(aTHX_ (state));
291	#define SAVE(state,flags) SB PUTBACK; save_state(aTHX_ (state),(flags)); SE	276	#define SAVE(state,flags) save_state(aTHX_ (state),(flags));
292		277
293	#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
294		279
295	static void	280	static void
296	load_state(pTHX_ Coro__State c)	281	load_state(pTHX_ Coro__State c)
…		…
370		355
371	PUSHs (Nullsv);	356	PUSHs (Nullsv);
372	/* this loop was inspired by pp_caller */	357	/* this loop was inspired by pp_caller */
373	for (;;)	358	for (;;)
374	{	359	{
375	do	360	while (cxix >= 0)
376	{	361	{
377	PERL_CONTEXT *cx = &ccstk[cxix--];	362	PERL_CONTEXT *cx = &ccstk[cxix--];
378		363
379	if (CxTYPE(cx) == CXt_SUB)	364	if (CxTYPE(cx) == CXt_SUB)
380	{	365	{
…		…
406	/* 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? */
407	/* my bold guess is as a simple, plain sub... */	392	/* my bold guess is as a simple, plain sub... */
408	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");
409	}	394	}
410	}	395	}
411	while (cxix >= 0);
412		396
413	if (top_si->si_type == PERLSI_MAIN)	397	if (top_si->si_type == PERLSI_MAIN)
414	break;	398	break;
415		399
416	top_si = top_si->si_prev;	400	top_si = top_si->si_prev;
…		…
422	}	406	}
423		407
424	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;
425	c->defsv = flags & TRANSFER_SAVE_DEFSV ? SvREFCNT_inc (DEFSV) : 0;	409	c->defsv = flags & TRANSFER_SAVE_DEFSV ? SvREFCNT_inc (DEFSV) : 0;
426	c->errsv = flags & TRANSFER_SAVE_ERRSV ? SvREFCNT_inc (ERRSV) : 0;	410	c->errsv = flags & TRANSFER_SAVE_ERRSV ? SvREFCNT_inc (ERRSV) : 0;
427
428	/* I have not the slightest idea of why av_reify is necessary */
429	/* but if it's missing the defav contents magically get replaced sometimes */
430	if (c->defav)
431	av_reify (c->defav);
432		411
433	c->dowarn = PL_dowarn;	412	c->dowarn = PL_dowarn;
434	c->in_eval = PL_in_eval;	413	c->in_eval = PL_in_eval;
435		414
436	c->curstackinfo = PL_curstackinfo;	415	c->curstackinfo = PL_curstackinfo;
…		…
508	* still there is a memleak of 128 bytes...	487	* still there is a memleak of 128 bytes...
509	*/	488	*/
510	STATIC void	489	STATIC void
511	destroy_stacks(pTHX)	490	destroy_stacks(pTHX)
512	{	491	{
		492	int destruct = PL_main_cv != Nullcv;
		493
		494	if (destruct)
		495	{
513	/* is this ugly, I ask? */	496	/* is this ugly, I ask? */
514	while (PL_scopestack_ix)	497	while (PL_scopestack_ix)
515	LEAVE;	498	LEAVE;
516		499
517	/* sure it is, but more important: is it correct?? :/ */	500	/* sure it is, but more important: is it correct?? :/ */
518	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 */
519	FREETMPS;	502	FREETMPS;
		503	}
520		504
521	while (PL_curstackinfo->si_next)	505	while (PL_curstackinfo->si_next)
522	PL_curstackinfo = PL_curstackinfo->si_next;	506	PL_curstackinfo = PL_curstackinfo->si_next;
523		507
524	while (PL_curstackinfo)	508	while (PL_curstackinfo)
…		…
529	dSP;	513	dSP;
530	SWITCHSTACK (PL_curstack, PL_curstackinfo->si_stack);	514	SWITCHSTACK (PL_curstack, PL_curstackinfo->si_stack);
531	PUTBACK; /* possibly superfluous */	515	PUTBACK; /* possibly superfluous */
532	}	516	}
533		517
		518	if (destruct)
		519	{
534	dounwind(-1);	520	dounwind(-1);
535
536	SvREFCNT_dec(PL_curstackinfo->si_stack);	521	SvREFCNT_dec(PL_curstackinfo->si_stack);
		522	}
		523
537	Safefree(PL_curstackinfo->si_cxstack);	524	Safefree(PL_curstackinfo->si_cxstack);
538	Safefree(PL_curstackinfo);	525	Safefree(PL_curstackinfo);
539	PL_curstackinfo = p;	526	PL_curstackinfo = p;
540	}	527	}
541		528
…		…
663	{	650	{
664	/*	651	/*
665	* this is a _very_ stripped down perl interpreter ;)	652	* this is a _very_ stripped down perl interpreter ;)
666	*/	653	*/
667	Coro__State ctx = (Coro__State)arg;	654	Coro__State ctx = (Coro__State)arg;
		655	JMPENV coro_start_env;
668		656
669	/FIXME//* must set up top_env here */	657	/* same as JMPENV_BOOTSTRAP */
		658	Zero(&coro_start_env, 1, JMPENV);
		659	coro_start_env.je_ret = -1;
		660	coro_start_env.je_mustcatch = TRUE;
		661	PL_top_env = &coro_start_env;
		662
670	ctx->cursp = 0;	663	ctx->cursp = 0;
671	PL_op = PL_op->op_next;	664	PL_op = PL_op->op_next;
672	CALLRUNOPS(aTHX);	665	CALLRUNOPS(aTHX);
673		666
674	abort ();	667	abort ();
675	}	668	}
676		669
677	STATIC void	670	STATIC void
678	transfer(pTHX_ struct coro prev, struct coro next, int flags)	671	transfer(pTHX_ struct coro prev, struct coro next, int flags)
679	{	672	{
680	dSP;
681	dSTACKLEVEL;	673	dSTACKLEVEL;
		674	static struct coro *xnext;
682		675
683	if (prev != next)	676	if (prev != next)
684	{	677	{
		678	xnext = next;
		679
685	if (next->mainstack)	680	if (next->mainstack)
686	{	681	{
687	SAVE (prev, flags);	682	SAVE (prev, flags);
688	LOAD (next);	683	LOAD (next);
689		684
…		…
712	continue_coro, (void *)next,	707	continue_coro, (void *)next,
713	next->stack->sptr, labs (next->stack->ssize));	708	next->stack->sptr, labs (next->stack->ssize));
714	}	709	}
715		710
716	coro_transfer (&(prev->stack->cctx), &(next->stack->cctx));	711	coro_transfer (&(prev->stack->cctx), &(next->stack->cctx));
		712	/* don't add any code here */
717	}	713	}
718		714
719	}	715	}
720	else if (next->tmps_ix == -2)	716	else if (next->tmps_ix == -2)
721	croak ("tried to transfer to running coroutine");	717	croak ("tried to transfer to running coroutine");
…		…
742	allocate_stack (next, 1);	738	allocate_stack (next, 1);
743	coro_create (&(next->stack->cctx),	739	coro_create (&(next->stack->cctx),
744	setup_coro, (void *)next,	740	setup_coro, (void *)next,
745	next->stack->sptr, labs (next->stack->ssize));	741	next->stack->sptr, labs (next->stack->ssize));
746	coro_transfer (&(prev->stack->cctx), &(next->stack->cctx));	742	coro_transfer (&(prev->stack->cctx), &(next->stack->cctx));
		743	/* don't add any code here */
747	}	744	}
748	}	745	}
749	else	746	else
750	setup_coro (next);	747	setup_coro (next);
751	}	748	}
752	}	749	}
753		750
		751	/*
		752	* xnext is now either prev or next, depending on wether
		753	* we switched the c stack or not. that's why i use a global
		754	* variable, that should become thread-specific at one point.
		755	*/
754	next->cursp = stacklevel;	756	xnext->cursp = stacklevel;
755	}	757	}
756		758
757	static struct coro *	759	static struct coro *
758	sv_to_coro (SV arg, const char funcname, const char *varname)	760	sv_to_coro (SV arg, const char funcname, const char *varname)
759	{	761	{
760	if (SvROK(arg) && SvTYPE(SvRV(arg)) == SVt_PVHV)	762	if (SvROK(arg) && SvTYPE(SvRV(arg)) == SVt_PVHV)
761	{	763	{
762	HE he = hv_fetch_ent((HV )SvRV(arg), ucoro_state_sv, 0, ucoro_state_hash);	764	HE he = hv_fetch_ent((HV )SvRV(arg), ucoro_state_sv, 0, ucoro_state_hash);
763		765
764	if (!he)	766	if (!he)
765	croak ("%s() -- %s is a hashref but lacks the " UCORO_STATE " key", funcname, varname);	767	croak ("%s() -- %s is a hashref but lacks the " UCORO_STATE " key", funcname, varname);
766		768
767	arg = HeVAL(he);	769	arg = HeVAL(he);
768	}	770	}
769		771
770	/* must also be changed inside Coro::Cont::yield */	772	/* must also be changed inside Coro::Cont::yield */
771	if (SvROK(arg) && SvSTASH(SvRV(arg)) == coro_state_stash)	773	if (SvROK(arg) && SvSTASH(SvRV(arg)) == coro_state_stash)
772	return (struct coro ) SvIV((SV)SvRV(arg));	774	return (struct coro ) SvIV((SV)SvRV(arg));
773	else	775
774	croak ("%s() -- %s is not (and contains not) a Coro::State object", funcname, varname);	776	croak ("%s() -- %s is not (and contains not) a Coro::State object", funcname, varname);
		777	/NORETURN/
		778	}
		779
		780	static void
		781	api_transfer(pTHX_ SV prev, SV next, int flags)
		782	{
		783	transfer(aTHX_
		784	sv_to_coro (prev, "Coro::transfer", "prev"),
		785	sv_to_coro (next, "Coro::transfer", "next"),
		786	flags);
		787	}
		788
		789	/ Coro ******************************************************************/
		790
		791	#define PRIO_MAX 3
		792	#define PRIO_HIGH 1
		793	#define PRIO_NORMAL 0
		794	#define PRIO_LOW -1
		795	#define PRIO_IDLE -3
		796	#define PRIO_MIN -4
		797
		798	/* for Coro.pm */
		799	static GV coro_current, coro_idle;
		800	static AV *coro_ready[PRIO_MAX-PRIO_MIN+1];
		801	static int coro_nready;
		802
		803	static void
		804	coro_enq (SV *sv)
		805	{
		806	if (SvROK (sv))
		807	{
		808	SV *hv = SvRV (sv);
		809	if (SvTYPE (hv) == SVt_PVHV)
		810	{
		811	SV *xprio = hv_fetch ((HV )hv, "prio", 4, 0);
		812	int prio = xprio ? SvIV (*xprio) : PRIO_NORMAL;
		813
		814	prio = prio > PRIO_MAX ? PRIO_MAX
		815	: prio < PRIO_MIN ? PRIO_MIN
		816	: prio;
		817
		818	av_push (coro_ready [prio - PRIO_MIN], sv);
		819	coro_nready++;
		820
		821	return;
		822	}
		823	}
		824
		825	croak ("Coro::ready tried to enqueue something that is not a coroutine");
		826	}
		827
		828	static SV *
		829	coro_deq (int min_prio)
		830	{
		831	int prio = PRIO_MAX - PRIO_MIN;
		832
		833	min_prio -= PRIO_MIN;
		834	if (min_prio < 0)
		835	min_prio = 0;
		836
		837	for (prio = PRIO_MAX - PRIO_MIN + 1; --prio >= min_prio; )
		838	if (av_len (coro_ready[prio]) >= 0)
		839	{
		840	coro_nready--;
		841	return av_shift (coro_ready[prio]);
		842	}
		843
		844	return 0;
		845	}
		846
		847	static void
		848	api_ready (SV *coro)
		849	{
		850	coro_enq (SvREFCNT_inc (coro));
		851	}
		852
		853	static void
		854	api_schedule (int cede)
		855	{
		856	SV prev, next;
		857
		858	prev = GvSV (coro_current);
		859
		860	if (cede)
		861	coro_enq (SvREFCNT_inc (prev));
		862
		863	next = coro_deq (PRIO_MIN);
		864
		865	if (!next)
		866	next = SvREFCNT_inc (GvSV (coro_idle));
		867
		868	GvSV (coro_current) = SvREFCNT_inc (next);
		869	transfer (aTHX_
		870	sv_to_coro (prev, "Coro::schedule", "current coroutine"),
		871	sv_to_coro (next, "Coro::schedule", "next coroutine"),
		872	TRANSFER_SAVE_ALL \| TRANSFER_LAZY_STACK);
		873	SvREFCNT_dec (next);
		874	SvREFCNT_dec (prev);
775	}	875	}
776		876
777	MODULE = Coro::State PACKAGE = Coro::State	877	MODULE = Coro::State PACKAGE = Coro::State
778		878
779	PROTOTYPES: ENABLE	879	PROTOTYPES: ENABLE
…		…
791		891
792	if (!padlist_cache)	892	if (!padlist_cache)
793	padlist_cache = newHV ();	893	padlist_cache = newHV ();
794		894
795	main_mainstack = PL_mainstack;	895	main_mainstack = PL_mainstack;
		896
		897	coroapi.ver = CORO_API_VERSION;
		898	coroapi.transfer = api_transfer;
796	}	899	}
797		900
798	Coro::State	901	Coro::State
799	_newprocess(args)	902	_newprocess(args)
800	SV * args	903	SV * args
…		…
833		936
834	if (coro->mainstack && coro->mainstack != main_mainstack)	937	if (coro->mainstack && coro->mainstack != main_mainstack)
835	{	938	{
836	struct coro temp;	939	struct coro temp;
837		940
		941	PUTBACK;
838	SAVE(aTHX_ (&temp), TRANSFER_SAVE_ALL);	942	SAVE(aTHX_ (&temp), TRANSFER_SAVE_ALL);
839	LOAD(aTHX_ coro);	943	LOAD(aTHX_ coro);
		944	SPAGAIN;
840		945
841	destroy_stacks (aTHX);	946	destroy_stacks (aTHX);
842		947
843	LOAD((&temp)); /* this will get rid of defsv etc.. */	948	LOAD((&temp)); /* this will get rid of defsv etc.. */
		949	SPAGAIN;
844		950
845	coro->mainstack = 0;	951	coro->mainstack = 0;
846	}	952	}
847		953
848	deallocate_stack (coro);	954	deallocate_stack (coro);
…		…
903		1009
904	# this is slightly dirty (should expose a c-level api)	1010	# this is slightly dirty (should expose a c-level api)
905		1011
906	BOOT:	1012	BOOT:
907	{	1013	{
		1014	int i;
		1015	HV *stash = gv_stashpv ("Coro", TRUE);
		1016
		1017	newCONSTSUB (stash, "PRIO_MAX", newSViv (PRIO_MAX));
		1018	newCONSTSUB (stash, "PRIO_HIGH", newSViv (PRIO_HIGH));
		1019	newCONSTSUB (stash, "PRIO_NORMAL", newSViv (PRIO_NORMAL));
		1020	newCONSTSUB (stash, "PRIO_LOW", newSViv (PRIO_LOW));
		1021	newCONSTSUB (stash, "PRIO_IDLE", newSViv (PRIO_IDLE));
		1022	newCONSTSUB (stash, "PRIO_MIN", newSViv (PRIO_MIN));
		1023
908	coro_current = gv_fetchpv ("Coro::current", TRUE, SVt_PV);	1024	coro_current = gv_fetchpv ("Coro::current", TRUE, SVt_PV);
909	coro_ready = newAV ();
910	coro_idle = gv_fetchpv ("Coro::idle" , TRUE, SVt_PV);	1025	coro_idle = gv_fetchpv ("Coro::idle" , TRUE, SVt_PV);
		1026
		1027	for (i = PRIO_MAX - PRIO_MIN + 1; i--; )
		1028	coro_ready[i] = newAV ();
		1029
		1030	{
		1031	SV *sv = perl_get_sv("Coro::API", 1);
		1032
		1033	coroapi.schedule = api_schedule;
		1034	coroapi.ready = api_ready;
		1035	coroapi.nready = &coro_nready;
		1036	coroapi.current = coro_current;
		1037
		1038	GCoroAPI = &coroapi;
		1039	sv_setiv(sv, (IV)&coroapi);
		1040	SvREADONLY_on(sv);
		1041	}
911	}	1042	}
912		1043
913	void	1044	void
914	ready(self)	1045	ready(self)
915	SV * self	1046	SV * self
916	CODE:	1047	CODE:
917	av_push (coro_ready, SvREFCNT_inc (self));	1048	api_ready (self);
		1049
		1050	int
		1051	nready(...)
		1052	PROTOTYPE:
		1053	CODE:
		1054	RETVAL = coro_nready;
		1055	OUTPUT:
		1056	RETVAL
918		1057
919	void	1058	void
920	schedule(...)	1059	schedule(...)
		1060	PROTOTYPE:
921	ALIAS:	1061	ALIAS:
922	cede = 1	1062	cede = 1
923	CODE:	1063	CODE:
924	SV *prev = GvSV (coro_current);	1064	api_schedule (ix);
925	SV *next = av_shift (coro_ready);
926		1065
927	if (next == &PL_sv_undef)
928	next = SvREFCNT_inc (GvSV (coro_idle));
929
930	if (ix)
931	av_push (coro_ready, SvREFCNT_inc (prev));
932
933	GvSV (coro_current) = SvREFCNT_inc (next);
934	transfer (sv_to_coro (prev, "Coro::schedule", "current coroutine"),
935	sv_to_coro (next, "Coro::schedule", "next coroutine"),
936	TRANSFER_SAVE_ALL \| TRANSFER_LAZY_STACK);
937	SvREFCNT_dec (next);
938	SvREFCNT_dec (prev);
939

Diff Legend

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

Comparing Coro/Coro/State.xs (file contents): Revision 1.21 by root, Sat Aug 11 19:59:19 2001 UTC vs. Revision 1.32 by root, Sun Aug 26 17:01:54 2001 UTC

Diff Legend

Comparing Coro/Coro/State.xs (file contents):
Revision 1.21 by root, Sat Aug 11 19:59:19 2001 UTC vs.
Revision 1.32 by root, Sun Aug 26 17:01:54 2001 UTC