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

Comparing Coro/Coro/State.xs (file contents):
Revision 1.22 by root, Sat Aug 11 23:10:56 2001 UTC vs.
Revision 1.35 by root, Mon Sep 24 01:36:20 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
		31	#define IN_DESTRUCT (PL_main_cv == Nullcv)
		32
46	#define labs(l) ((l) >= 0 ? (l) : -(l))	33	#define labs(l) ((l) >= 0 ? (l) : -(l))
		34
		35	#include "CoroAPI.h"
		36
		37	static struct CoroAPI coroapi;
47		38
48	/* this is actually not only the c stack but also c registers etc... */	39	/* this is actually not only the c stack but also c registers etc... */
49	typedef struct {	40	typedef struct {
50	int refcnt; /* pointer reference counter */	41	int refcnt; /* pointer reference counter */
51	int usecnt; /* shared by how many coroutines */	42	int usecnt; /* shared by how many coroutines */
…		…
206		197
207	return newpadlist;	198	return newpadlist;
208	}	199	}
209		200
210	#ifdef MAY_FLUSH	201	#ifdef MAY_FLUSH
211	STATIC AV *	202	STATIC void
212	free_padlist (AV *padlist)	203	free_padlist (AV *padlist)
213	{	204	{
214	/* may be during global destruction */	205	/* may be during global destruction */
215	if (SvREFCNT(padlist))	206	if (SvREFCNT(padlist))
216	{	207	{
…		…
281	#endif	272	#endif
282		273
283	#define SB do {	274	#define SB do {
284	#define SE } while (0)	275	#define SE } while (0)
285		276
286	#define LOAD(state) SB load_state(aTHX_ (state)); SPAGAIN; SE	277	#define LOAD(state) load_state(aTHX_ (state));
287	#define SAVE(state,flags) SB PUTBACK; save_state(aTHX_ (state),(flags)); SE	278	#define SAVE(state,flags) save_state(aTHX_ (state),(flags));
288		279
289	#define REPLACE_SV(sv,val) SB SvREFCNT_dec(sv); (sv) = (val); SE	280	#define REPLACE_SV(sv,val) SB SvREFCNT_dec(sv); (sv) = (val); SE
290		281
291	static void	282	static void
292	load_state(pTHX_ Coro__State c)	283	load_state(pTHX_ Coro__State c)
…		…
366		357
367	PUSHs (Nullsv);	358	PUSHs (Nullsv);
368	/* this loop was inspired by pp_caller */	359	/* this loop was inspired by pp_caller */
369	for (;;)	360	for (;;)
370	{	361	{
371	do	362	while (cxix >= 0)
372	{	363	{
373	PERL_CONTEXT *cx = &ccstk[cxix--];	364	PERL_CONTEXT *cx = &ccstk[cxix--];
374		365
375	if (CxTYPE(cx) == CXt_SUB)	366	if (CxTYPE(cx) == CXt_SUB)
376	{	367	{
…		…
402	/* I never used formats, so how should I know how these are implemented? */	393	/* I never used formats, so how should I know how these are implemented? */
403	/* my bold guess is as a simple, plain sub... */	394	/* my bold guess is as a simple, plain sub... */
404	croak ("CXt_FORMAT not yet handled. Don't switch coroutines from within formats");	395	croak ("CXt_FORMAT not yet handled. Don't switch coroutines from within formats");
405	}	396	}
406	}	397	}
407	while (cxix >= 0);
408		398
409	if (top_si->si_type == PERLSI_MAIN)	399	if (top_si->si_type == PERLSI_MAIN)
410	break;	400	break;
411		401
412	top_si = top_si->si_prev;	402	top_si = top_si->si_prev;
…		…
418	}	408	}
419		409
420	c->defav = flags & TRANSFER_SAVE_DEFAV ? (AV *)SvREFCNT_inc (GvAV (PL_defgv)) : 0;	410	c->defav = flags & TRANSFER_SAVE_DEFAV ? (AV *)SvREFCNT_inc (GvAV (PL_defgv)) : 0;
421	c->defsv = flags & TRANSFER_SAVE_DEFSV ? SvREFCNT_inc (DEFSV) : 0;	411	c->defsv = flags & TRANSFER_SAVE_DEFSV ? SvREFCNT_inc (DEFSV) : 0;
422	c->errsv = flags & TRANSFER_SAVE_ERRSV ? SvREFCNT_inc (ERRSV) : 0;	412	c->errsv = flags & TRANSFER_SAVE_ERRSV ? SvREFCNT_inc (ERRSV) : 0;
423
424	/* I have not the slightest idea of why av_reify is necessary */
425	/* but if it's missing the defav contents magically get replaced sometimes */
426	if (c->defav)
427	av_reify (c->defav);
428		413
429	c->dowarn = PL_dowarn;	414	c->dowarn = PL_dowarn;
430	c->in_eval = PL_in_eval;	415	c->in_eval = PL_in_eval;
431		416
432	c->curstackinfo = PL_curstackinfo;	417	c->curstackinfo = PL_curstackinfo;
…		…
504	* still there is a memleak of 128 bytes...	489	* still there is a memleak of 128 bytes...
505	*/	490	*/
506	STATIC void	491	STATIC void
507	destroy_stacks(pTHX)	492	destroy_stacks(pTHX)
508	{	493	{
		494	if (!IN_DESTRUCT)
		495	{
509	/* is this ugly, I ask? */	496	/* is this ugly, I ask? */
510	while (PL_scopestack_ix)	497	while (PL_scopestack_ix)
511	LEAVE;	498	LEAVE;
512		499
513	/* sure it is, but more important: is it correct?? :/ */	500	/* sure it is, but more important: is it correct?? :/ */
514	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 */
515	FREETMPS;	502	FREETMPS;
		503	}
516		504
517	while (PL_curstackinfo->si_next)	505	while (PL_curstackinfo->si_next)
518	PL_curstackinfo = PL_curstackinfo->si_next;	506	PL_curstackinfo = PL_curstackinfo->si_next;
519		507
520	while (PL_curstackinfo)	508	while (PL_curstackinfo)
…		…
525	dSP;	513	dSP;
526	SWITCHSTACK (PL_curstack, PL_curstackinfo->si_stack);	514	SWITCHSTACK (PL_curstack, PL_curstackinfo->si_stack);
527	PUTBACK; /* possibly superfluous */	515	PUTBACK; /* possibly superfluous */
528	}	516	}
529		517
		518	if (!IN_DESTRUCT)
		519	{
530	dounwind(-1);	520	dounwind(-1);
531
532	SvREFCNT_dec(PL_curstackinfo->si_stack);	521	SvREFCNT_dec(PL_curstackinfo->si_stack);
		522	}
		523
533	Safefree(PL_curstackinfo->si_cxstack);	524	Safefree(PL_curstackinfo->si_cxstack);
534	Safefree(PL_curstackinfo);	525	Safefree(PL_curstackinfo);
535	PL_curstackinfo = p;	526	PL_curstackinfo = p;
536	}	527	}
537		528
…		…
659	{	650	{
660	/*	651	/*
661	* this is a _very_ stripped down perl interpreter ;)	652	* this is a _very_ stripped down perl interpreter ;)
662	*/	653	*/
663	Coro__State ctx = (Coro__State)arg;	654	Coro__State ctx = (Coro__State)arg;
		655	JMPENV coro_start_env;
664		656
665	/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
666	ctx->cursp = 0;	663	ctx->cursp = 0;
667	PL_op = PL_op->op_next;	664	PL_op = PL_op->op_next;
668	CALLRUNOPS(aTHX);	665	CALLRUNOPS(aTHX);
669		666
670	abort ();	667	abort ();
671	}	668	}
672		669
673	STATIC void	670	STATIC void
674	transfer(pTHX_ struct coro prev, struct coro next, int flags)	671	transfer(pTHX_ struct coro prev, struct coro next, int flags)
675	{	672	{
676	dSP;
677	dSTACKLEVEL;	673	dSTACKLEVEL;
		674	static struct coro *xnext;
678		675
679	if (prev != next)	676	if (prev != next)
680	{	677	{
		678	xnext = next;
		679
681	if (next->mainstack)	680	if (next->mainstack)
682	{	681	{
683	SAVE (prev, flags);	682	SAVE (prev, flags);
684	LOAD (next);	683	LOAD (next);
685		684
…		…
708	continue_coro, (void *)next,	707	continue_coro, (void *)next,
709	next->stack->sptr, labs (next->stack->ssize));	708	next->stack->sptr, labs (next->stack->ssize));
710	}	709	}
711		710
712	coro_transfer (&(prev->stack->cctx), &(next->stack->cctx));	711	coro_transfer (&(prev->stack->cctx), &(next->stack->cctx));
		712	/* don't add any code here */
713	}	713	}
714		714
715	}	715	}
716	else if (next->tmps_ix == -2)	716	else if (next->tmps_ix == -2)
717	croak ("tried to transfer to running coroutine");	717	croak ("tried to transfer to running coroutine");
…		…
738	allocate_stack (next, 1);	738	allocate_stack (next, 1);
739	coro_create (&(next->stack->cctx),	739	coro_create (&(next->stack->cctx),
740	setup_coro, (void *)next,	740	setup_coro, (void *)next,
741	next->stack->sptr, labs (next->stack->ssize));	741	next->stack->sptr, labs (next->stack->ssize));
742	coro_transfer (&(prev->stack->cctx), &(next->stack->cctx));	742	coro_transfer (&(prev->stack->cctx), &(next->stack->cctx));
		743	/* don't add any code here */
743	}	744	}
744	}	745	}
745	else	746	else
746	setup_coro (next);	747	setup_coro (next);
747	}	748	}
748	}
749		749
		750	/*
		751	* xnext is now either prev or next, depending on wether
		752	* we switched the c stack or not. that's why i use a global
		753	* variable, that should become thread-specific at one point.
		754	*/
750	next->cursp = stacklevel;	755	xnext->cursp = stacklevel;
		756	}
751	}	757	}
752		758
753	static struct coro *	759	static struct coro *
754	sv_to_coro (SV arg, const char funcname, const char *varname)	760	sv_to_coro (SV arg, const char funcname, const char *varname)
755	{	761	{
756	if (SvROK(arg) && SvTYPE(SvRV(arg)) == SVt_PVHV)	762	if (SvROK(arg) && SvTYPE(SvRV(arg)) == SVt_PVHV)
757	{	763	{
758	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);
759		765
760	if (!he)	766	if (!he)
761	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);
762		768
763	arg = HeVAL(he);	769	arg = HeVAL(he);
764	}	770	}
765		771
766	/* must also be changed inside Coro::Cont::yield */	772	/* must also be changed inside Coro::Cont::yield */
		773	if (SvROK(arg) && SvOBJECT(SvRV(arg))
767	if (SvROK(arg) && SvSTASH(SvRV(arg)) == coro_state_stash)	774	&& SvSTASH(SvRV(arg)) == coro_state_stash)
768	return (struct coro ) SvIV((SV)SvRV(arg));	775	return (struct coro ) SvIV((SV)SvRV(arg));
769	else	776
770	croak ("%s() -- %s is not (and contains not) a Coro::State object", funcname, varname);	777	croak ("%s() -- %s is not (and contains not) a Coro::State object", funcname, varname);
		778	/NORETURN/
		779	}
		780
		781	static void
		782	api_transfer(pTHX_ SV prev, SV next, int flags)
		783	{
		784	transfer(aTHX_
		785	sv_to_coro (prev, "Coro::transfer", "prev"),
		786	sv_to_coro (next, "Coro::transfer", "next"),
		787	flags);
771	}	788	}
772		789
773	/ Coro ******************************************************************/	790	/ Coro ******************************************************************/
774		791
775	#define PRIO_MAX 3	792	#define PRIO_MAX 3
…		…
780	#define PRIO_MIN -4	797	#define PRIO_MIN -4
781		798
782	/* for Coro.pm */	799	/* for Coro.pm */
783	static GV coro_current, coro_idle;	800	static GV coro_current, coro_idle;
784	static AV *coro_ready[PRIO_MAX-PRIO_MIN+1];	801	static AV *coro_ready[PRIO_MAX-PRIO_MIN+1];
		802	static int coro_nready;
785		803
786	static void	804	static void
787	coro_enq (SV *sv)	805	coro_enq (SV *sv)
788	{	806	{
789	if (SvROK (sv))	807	if (SvROK (sv))
…		…
797	prio = prio > PRIO_MAX ? PRIO_MAX	815	prio = prio > PRIO_MAX ? PRIO_MAX
798	: prio < PRIO_MIN ? PRIO_MIN	816	: prio < PRIO_MIN ? PRIO_MIN
799	: prio;	817	: prio;
800		818
801	av_push (coro_ready [prio - PRIO_MIN], sv);	819	av_push (coro_ready [prio - PRIO_MIN], sv);
		820	coro_nready++;
802		821
803	return;	822	return;
804	}	823	}
805	}	824	}
806		825
…		…
816	if (min_prio < 0)	835	if (min_prio < 0)
817	min_prio = 0;	836	min_prio = 0;
818		837
819	for (prio = PRIO_MAX - PRIO_MIN + 1; --prio >= min_prio; )	838	for (prio = PRIO_MAX - PRIO_MIN + 1; --prio >= min_prio; )
820	if (av_len (coro_ready[prio]) >= 0)	839	if (av_len (coro_ready[prio]) >= 0)
		840	{
		841	coro_nready--;
821	return av_shift (coro_ready[prio]);	842	return av_shift (coro_ready[prio]);
		843	}
822		844
823	return 0;	845	return 0;
		846	}
		847
		848	static void
		849	api_ready (SV *coro)
		850	{
		851	coro_enq (SvREFCNT_inc (coro));
		852	}
		853
		854	static void
		855	api_schedule (int cede)
		856	{
		857	SV prev, next;
		858
		859	prev = GvSV (coro_current);
		860
		861	if (cede)
		862	coro_enq (SvREFCNT_inc (prev));
		863
		864	next = coro_deq (PRIO_MIN);
		865
		866	if (!next)
		867	next = SvREFCNT_inc (GvSV (coro_idle));
		868
		869	GvSV (coro_current) = SvREFCNT_inc (next);
		870	transfer (aTHX_
		871	sv_to_coro (prev, "Coro::schedule", "current coroutine"),
		872	sv_to_coro (next, "Coro::schedule", "next coroutine"),
		873	TRANSFER_SAVE_ALL \| TRANSFER_LAZY_STACK);
		874	SvREFCNT_dec (next);
		875	SvREFCNT_dec (prev);
824	}	876	}
825		877
826	MODULE = Coro::State PACKAGE = Coro::State	878	MODULE = Coro::State PACKAGE = Coro::State
827		879
828	PROTOTYPES: ENABLE	880	PROTOTYPES: ENABLE
…		…
840		892
841	if (!padlist_cache)	893	if (!padlist_cache)
842	padlist_cache = newHV ();	894	padlist_cache = newHV ();
843		895
844	main_mainstack = PL_mainstack;	896	main_mainstack = PL_mainstack;
		897
		898	coroapi.ver = CORO_API_VERSION;
		899	coroapi.transfer = api_transfer;
845	}	900	}
846		901
847	Coro::State	902	Coro::State
848	_newprocess(args)	903	_newprocess(args)
849	SV * args	904	SV * args
…		…
882		937
883	if (coro->mainstack && coro->mainstack != main_mainstack)	938	if (coro->mainstack && coro->mainstack != main_mainstack)
884	{	939	{
885	struct coro temp;	940	struct coro temp;
886		941
		942	PUTBACK;
887	SAVE(aTHX_ (&temp), TRANSFER_SAVE_ALL);	943	SAVE(aTHX_ (&temp), TRANSFER_SAVE_ALL);
888	LOAD(aTHX_ coro);	944	LOAD(aTHX_ coro);
		945	SPAGAIN;
889		946
890	destroy_stacks (aTHX);	947	destroy_stacks (aTHX);
891		948
892	LOAD((&temp)); /* this will get rid of defsv etc.. */	949	LOAD((&temp)); /* this will get rid of defsv etc.. */
		950	SPAGAIN;
893		951
894	coro->mainstack = 0;	952	coro->mainstack = 0;
895	}	953	}
896		954
897	deallocate_stack (coro);	955	deallocate_stack (coro);
…		…
967	coro_current = gv_fetchpv ("Coro::current", TRUE, SVt_PV);	1025	coro_current = gv_fetchpv ("Coro::current", TRUE, SVt_PV);
968	coro_idle = gv_fetchpv ("Coro::idle" , TRUE, SVt_PV);	1026	coro_idle = gv_fetchpv ("Coro::idle" , TRUE, SVt_PV);
969		1027
970	for (i = PRIO_MAX - PRIO_MIN + 1; i--; )	1028	for (i = PRIO_MAX - PRIO_MIN + 1; i--; )
971	coro_ready[i] = newAV ();	1029	coro_ready[i] = newAV ();
		1030
		1031	{
		1032	SV *sv = perl_get_sv("Coro::API", 1);
		1033
		1034	coroapi.schedule = api_schedule;
		1035	coroapi.ready = api_ready;
		1036	coroapi.nready = &coro_nready;
		1037	coroapi.current = coro_current;
		1038
		1039	GCoroAPI = &coroapi;
		1040	sv_setiv(sv, (IV)&coroapi);
		1041	SvREADONLY_on(sv);
		1042	}
972	}	1043	}
973		1044
974	void	1045	void
975	ready(self)	1046	ready(self)
976	SV * self	1047	SV * self
		1048	PROTOTYPE: $
977	CODE:	1049	CODE:
978	coro_enq (SvREFCNT_inc (self));	1050	api_ready (self);
		1051
		1052	int
		1053	nready(...)
		1054	PROTOTYPE:
		1055	CODE:
		1056	RETVAL = coro_nready;
		1057	OUTPUT:
		1058	RETVAL
979		1059
980	void	1060	void
981	schedule(...)	1061	schedule(...)
		1062	PROTOTYPE:
982	ALIAS:	1063	ALIAS:
983	cede = 1	1064	cede = 1
984	CODE:	1065	CODE:
985	SV prev, next;	1066	api_schedule (ix);
986		1067
987	prev = GvSV (coro_current);
988
989	if (ix)
990	coro_enq (SvREFCNT_inc (prev));
991
992	next = coro_deq (PRIO_MIN);
993
994	if (!next)
995	next = SvREFCNT_inc (GvSV (coro_idle));
996
997	GvSV (coro_current) = SvREFCNT_inc (next);
998	transfer (sv_to_coro (prev, "Coro::schedule", "current coroutine"),
999	sv_to_coro (next, "Coro::schedule", "next coroutine"),
1000	TRANSFER_SAVE_ALL \| TRANSFER_LAZY_STACK);
1001	SvREFCNT_dec (next);
1002	SvREFCNT_dec (prev);
1003

Diff Legend

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

Comparing Coro/Coro/State.xs (file contents): Revision 1.22 by root, Sat Aug 11 23:10:56 2001 UTC vs. Revision 1.35 by root, Mon Sep 24 01:36:20 2001 UTC

Diff Legend

Comparing Coro/Coro/State.xs (file contents):
Revision 1.22 by root, Sat Aug 11 23:10:56 2001 UTC vs.
Revision 1.35 by root, Mon Sep 24 01:36:20 2001 UTC