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

Comparing Coro/Coro/State.xs (file contents):
Revision 1.80 by root, Thu Nov 2 20:00:00 2006 UTC vs.
Revision 1.87 by root, Fri Nov 24 13:40:36 2006 UTC

…		…
100	void *sptr;	100	void *sptr;
101	long ssize; /* positive == mmap, otherwise malloc */	101	long ssize; /* positive == mmap, otherwise malloc */
102	} coro_stack;	102	} coro_stack;
103		103
104	struct coro {	104	struct coro {
105	/* the top-level JMPENV for each coroutine, needed to catch dies. */
106	JMPENV start_env;
107
108	/* the optional C context */	105	/* the optional C context */
109	coro_stack *stack;	106	coro_stack *stack;
110	void *cursp;	107	void *cursp;
111	int gencnt;	108	int gencnt;
112		109
…		…
148	I32 retstack_max;	145	I32 retstack_max;
149	PMOP *curpm;	146	PMOP *curpm;
150	COP *curcop;	147	COP *curcop;
151	JMPENV *top_env;	148	JMPENV *top_env;
152		149
		150	/* coro process data */
		151	int prio;
		152
153	/* data associated with this coroutine (initial args) */	153	/* data associated with this coroutine (initial args) */
154	AV *args;	154	AV *args;
		155	int refcnt;
155	};	156	};
156		157
157	typedef struct coro *Coro__State;	158	typedef struct coro *Coro__State;
158	typedef struct coro *Coro__State_or_hashref;	159	typedef struct coro *Coro__State_or_hashref;
159		160
…		…
661	* this is a _very_ stripped down perl interpreter ;)	662	* this is a _very_ stripped down perl interpreter ;)
662	*/	663	*/
663	dTHX;	664	dTHX;
664	Coro__State ctx = (Coro__State)arg;	665	Coro__State ctx = (Coro__State)arg;
665		666
666	PL_top_env = &ctx->start_env;	667	PL_top_env = &PL_start_env;
667		668
668	ctx->cursp = 0;	669	ctx->cursp = 0;
669	PL_op = PL_op->op_next;	670	PL_op = PL_op->op_next;
670	CALLRUNOPS(aTHX);	671	CALLRUNOPS(aTHX);
671		672
672	abort ();	673	abort ();
673	}	674	}
674		675
		676	/* never call directly, always through the coro_state_transfer global variable */
675	static void	677	static void
676	transfer (pTHX_ struct coro prev, struct coro next, int flags)	678	transfer_impl (pTHX_ struct coro prev, struct coro next, int flags)
677	{	679	{
678	dSTACKLEVEL;	680	dSTACKLEVEL;
679		681
680	if (prev != next)	682	if (prev != next)
681	{	683	{
		684	/* has this coro been created yet? */
682	if (next->mainstack)	685	if (next->mainstack)
683	{	686	{
684	LOCK;	687	LOCK;
685	SAVE (prev, flags);	688	SAVE (prev, flags);
686	LOAD (next);	689	LOAD (next);
…		…
725	{	728	{
726	LOCK;	729	LOCK;
727	SAVE (prev, -1); /* first get rid of the old state */	730	SAVE (prev, -1); /* first get rid of the old state */
728	UNLOCK;	731	UNLOCK;
729		732
		733	/* create the coroutine for the first time */
730	if (flags & TRANSFER_SAVE_CCTXT)	734	if (flags & TRANSFER_SAVE_CCTXT)
731	{	735	{
732	if (!prev->stack)	736	if (!prev->stack)
733	allocate_stack (prev, 0);	737	allocate_stack (prev, 0);
734		738
		739	/* the new coroutine starts with start_env again */
		740	PL_top_env = &PL_start_env;
		741
735	if (prev->stack->sptr && flags & TRANSFER_LAZY_STACK)	742	if (prev->stack->sptr && flags & TRANSFER_LAZY_STACK)
736	{	743	{
737	PL_top_env = &next->start_env;
738
739	setup_coro (next);	744	setup_coro (next);
740	next->cursp = stacklevel;	745	next->cursp = stacklevel;
741		746
742	prev->stack->refcnt++;	747	prev->stack->refcnt++;
743	prev->stack->usecnt++;	748	prev->stack->usecnt++;
…		…
771	coro_mortal = 0;	776	coro_mortal = 0;
772	}	777	}
773	UNLOCK;	778	UNLOCK;
774	}	779	}
775		780
		781	/* use this function pointer to call the above function */
		782	/* this is done to increase chances of the compiler not inlining the call */
		783	void (coro_state_transfer)(pTHX_ struct coro prev, struct coro *next, int flags) = transfer_impl;
		784
776	#define SV_CORO(sv,func) \	785	#define SV_CORO(sv,func) \
777	do { \	786	do { \
778	if (SvROK (sv)) \	787	if (SvROK (sv)) \
779	sv = SvRV (sv); \	788	sv = SvRV (sv); \
780	\	789	\
781	if (SvTYPE (sv) == SVt_PVHV) \	790	if (SvTYPE (sv) == SVt_PVHV && SvSTASH (sv) != coro_state_stash) \
782	{ \	791	{ \
783	HE he = hv_fetch_ent ((HV )sv, ucoro_state_sv, 0, ucoro_state_hash); \	792	HE he = hv_fetch_ent ((HV )sv, ucoro_state_sv, 0, ucoro_state_hash); \
784	\	793	\
785	if (!he) \	794	if (!he) \
786	croak ("%s() -- %s is a hashref but lacks the " UCORO_STATE " key", func, # sv); \	795	croak ("%s() -- %s is a hashref but lacks the " UCORO_STATE " key", func, # sv); \
…		…
792	if (!SvOBJECT (sv) \|\| SvSTASH (sv) != coro_state_stash) \	801	if (!SvOBJECT (sv) \|\| SvSTASH (sv) != coro_state_stash) \
793	croak ("%s() -- %s is not (and contains not) a Coro::State object", func, # sv); \	802	croak ("%s() -- %s is not (and contains not) a Coro::State object", func, # sv); \
794	\	803	\
795	} while(0)	804	} while(0)
796		805
797	#define SvSTATE(sv) INT2PTR (struct coro *, SvIV (sv))	806	static void
		807	coro_state_destroy (struct coro *coro)
		808	{
		809	if (coro->refcnt--)
		810	return;
798		811
		812	if (coro->mainstack && coro->mainstack != main_mainstack)
		813	{
		814	struct coro temp;
		815
		816	SAVE (aTHX_ (&temp), TRANSFER_SAVE_ALL);
		817	LOAD (aTHX_ coro);
		818
		819	destroy_stacks (aTHX);
		820
		821	LOAD ((&temp)); /* this will get rid of defsv etc.. */
		822
		823	coro->mainstack = 0;
		824	}
		825
		826	deallocate_stack (coro);
		827	SvREFCNT_dec (coro->args);
		828	Safefree (coro);
		829	}
		830
799	static void	831	static int
		832	coro_state_clear (SV sv, MAGIC mg)
		833	{
		834	struct coro coro = (struct coro )mg->mg_ptr;
		835	mg->mg_ptr = 0;
		836
		837	coro_state_destroy (coro);
		838
		839	return 0;
		840	}
		841
		842	static int
		843	coro_state_dup (MAGIC mg, CLONE_PARAMS params)
		844	{
		845	struct coro coro = (struct coro )mg->mg_ptr;
		846
		847	++coro->refcnt;
		848
		849	return 0;
		850	}
		851
		852	static MGVTBL coro_state_vtbl = { 0, 0, 0, 0, coro_state_clear, 0, coro_state_dup, 0 };
		853
		854	static struct coro *
		855	SvSTATE (SV *coro)
		856	{
		857	MAGIC *mg = SvMAGIC (SvROK (coro) ? SvRV (coro) : coro);
		858	assert (mg->mg_type == PERL_MAGIC_ext);
		859	return (struct coro *)mg->mg_ptr;
		860	}
		861
		862	static void
800	api_transfer(pTHX_ SV prev, SV next, int flags)	863	api_transfer (pTHX_ SV prev, SV next, int flags)
801	{	864	{
802	SV_CORO (prev, "Coro::transfer");	865	SV_CORO (prev, "Coro::transfer");
803	SV_CORO (next, "Coro::transfer");	866	SV_CORO (next, "Coro::transfer");
804		867
805	transfer (aTHX_ SvSTATE (prev), SvSTATE (next), flags);	868	coro_state_transfer (aTHX_ SvSTATE (prev), SvSTATE (next), flags);
806	}	869	}
807		870
808	/ Coro ******************************************************************/	871	/ Coro ******************************************************************/
809		872
810	#define PRIO_MAX 3	873	#define PRIO_MAX 3
…		…
814	#define PRIO_IDLE -3	877	#define PRIO_IDLE -3
815	#define PRIO_MIN -4	878	#define PRIO_MIN -4
816		879
817	/* for Coro.pm */	880	/* for Coro.pm */
818	static GV coro_current, coro_idle;	881	static GV coro_current, coro_idle;
819	static AV *coro_ready[PRIO_MAX-PRIO_MIN+1];	882	static AV *coro_ready [PRIO_MAX-PRIO_MIN+1];
820	static int coro_nready;	883	static int coro_nready;
821		884
822	static void	885	static void
823	coro_enq (pTHX_ SV *sv)	886	coro_enq (pTHX_ SV *sv)
824	{	887	{
825	SV **xprio;
826	int prio;	888	int prio;
827		889
828	if (SvTYPE (sv) != SVt_PVHV)	890	if (SvTYPE (sv) != SVt_PVHV)
829	croak ("Coro::ready tried to enqueue something that is not a coroutine");	891	croak ("Coro::ready tried to enqueue something that is not a coroutine");
830		892
831	xprio = hv_fetch ((HV *)sv, "prio", 4, 0);	893	{
832	prio = xprio ? SvIV (*xprio) : PRIO_NORMAL;	894	SV *coro = sv;
833		895	SV_CORO (coro, "omg");
834	prio = prio > PRIO_MAX ? PRIO_MAX	896	prio = SvSTATE (coro)->prio;
835	: prio < PRIO_MIN ? PRIO_MIN	897	}
836	: prio;
837		898
838	av_push (coro_ready [prio - PRIO_MIN], sv);	899	av_push (coro_ready [prio - PRIO_MIN], sv);
839	coro_nready++;	900	coro_nready++;
840	}	901	}
841		902
…		…
847	min_prio -= PRIO_MIN;	908	min_prio -= PRIO_MIN;
848	if (min_prio < 0)	909	if (min_prio < 0)
849	min_prio = 0;	910	min_prio = 0;
850		911
851	for (prio = PRIO_MAX - PRIO_MIN + 1; --prio >= min_prio; )	912	for (prio = PRIO_MAX - PRIO_MIN + 1; --prio >= min_prio; )
852	if (av_len (coro_ready[prio]) >= 0)	913	if (AvFILLp (coro_ready [prio]) >= 0)
853	{	914	{
854	coro_nready--;	915	coro_nready--;
855	return av_shift (coro_ready[prio]);	916	return av_shift (coro_ready [prio]);
856	}	917	}
857		918
858	return 0;	919	return 0;
859	}	920	}
860		921
…		…
894		955
895	SV_CORO (next, "Coro::schedule");	956	SV_CORO (next, "Coro::schedule");
896		957
897	UNLOCK;	958	UNLOCK;
898		959
899	transfer (aTHX_ SvSTATE (prev), SvSTATE (next),	960	coro_state_transfer (aTHX_ SvSTATE (prev), SvSTATE (next),
900	TRANSFER_SAVE_ALL \| TRANSFER_LAZY_STACK);	961	TRANSFER_SAVE_ALL \| TRANSFER_LAZY_STACK);
901	}	962	}
902		963
903	static void	964	static void
904	api_cede (void)	965	api_cede (void)
905	{	966	{
…		…
912	api_schedule ();	973	api_schedule ();
913	}	974	}
914		975
915	MODULE = Coro::State PACKAGE = Coro::State	976	MODULE = Coro::State PACKAGE = Coro::State
916		977
917	PROTOTYPES: ENABLE	978	PROTOTYPES: DISABLE
918		979
919	BOOT:	980	BOOT:
920	{ /* {} necessary for stoopid perl-5.6.x */	981	{ /* {} necessary for stoopid perl-5.6.x */
921	#ifdef USE_ITHREADS	982	#ifdef USE_ITHREADS
922	MUTEX_INIT (&coro_mutex);	983	MUTEX_INIT (&coro_mutex);
…		…
934		995
935	main_mainstack = PL_mainstack;	996	main_mainstack = PL_mainstack;
936		997
937	coroapi.ver = CORO_API_VERSION;	998	coroapi.ver = CORO_API_VERSION;
938	coroapi.transfer = api_transfer;	999	coroapi.transfer = api_transfer;
939	}
940		1000
941	Coro::State	1001	assert (("PRIO_NORMAL must be 0", !PRIO_NORMAL));
942	_newprocess(args)	1002	}
943	SV * args	1003
944	PROTOTYPE: $	1004	SV *
		1005	new (char *klass, ...)
945	CODE:	1006	CODE:
946	Coro__State coro;	1007	{
		1008	struct coro *coro;
		1009	HV *hv;
		1010	int i;
947		1011
948	if (!SvROK (args) \|\| SvTYPE (SvRV (args)) != SVt_PVAV)
949	croak ("Coro::State::_newprocess expects an arrayref");
950
951	Newz (0, coro, 1, struct coro);	1012	Newz (0, coro, 1, struct coro);
		1013	coro->args = newAV ();
952		1014
953	coro->args = (AV *)SvREFCNT_inc (SvRV (args));	1015	for (i = 1; i < items; i++)
		1016	av_push (coro->args, newSVsv (ST (i)));
		1017
954	/coro->mainstack = 0; //actual work is done inside transfer /	1018	/coro->mainstack = 0; //actual work is done inside transfer /
955	/coro->stack = 0;/	1019	/coro->stack = 0;/
956		1020
957	/* same as JMPENV_BOOTSTRAP */	1021	hv = newHV ();
958	/* we might be able to recycle start_env, but safe is safe */	1022	sv_magicext ((SV )hv, 0, PERL_MAGIC_ext, &coro_state_vtbl, (char )coro, 0)->mg_flags \|= MGf_DUP;
959	/Zero (&coro->start_env, 1, JMPENV);/	1023	RETVAL = sv_bless (newRV_noinc ((SV *)hv), gv_stashpv (klass, 1));
960	coro->start_env.je_ret = -1;	1024	}
961	coro->start_env.je_mustcatch = TRUE;
962
963	RETVAL = coro;
964	OUTPUT:	1025	OUTPUT:
965	RETVAL	1026	RETVAL
966		1027
967	void	1028	void
968	transfer(prev, next, flags)	1029	transfer(prev, next, flags)
969	SV *prev	1030	SV *prev
970	SV *next	1031	SV *next
971	int flags	1032	int flags
972	PROTOTYPE: @
973	CODE:	1033	CODE:
974	PUTBACK;	1034	PUTBACK;
975	SV_CORO (next, "Coro::transfer");	1035	SV_CORO (next, "Coro::transfer");
976	SV_CORO (prev, "Coro::transfer");	1036	SV_CORO (prev, "Coro::transfer");
977	transfer (aTHX_ SvSTATE (prev), SvSTATE (next), flags);	1037	coro_state_transfer (aTHX_ SvSTATE (prev), SvSTATE (next), flags);
978	SPAGAIN;	1038	SPAGAIN;
979		1039
		1040	int
		1041	prio (Coro::State coro, int newprio = 0)
		1042	ALIAS:
		1043	nice = 1
		1044	CODE:
		1045	{
		1046	RETVAL = coro->prio;
		1047
		1048	if (items > 1)
		1049	{
		1050	if (ix)
		1051	newprio += coro->prio;
		1052
		1053	if (newprio < PRIO_MIN) newprio = PRIO_MIN;
		1054	if (newprio > PRIO_MAX) newprio = PRIO_MAX;
		1055
		1056	coro->prio = newprio;
		1057	}
		1058	}
		1059
980	void	1060	void
981	DESTROY(coro)	1061	_clone_state_from (SV dst, SV src)
982	Coro::State coro	1062	CODE:
983	CODE:	1063	{
		1064	struct coro *coro_src = SvSTATE (src);
984		1065
985	if (coro->mainstack && coro->mainstack != main_mainstack)	1066	sv_unmagic (SvRV (dst), PERL_MAGIC_ext);
986	{
987	struct coro temp;
988		1067
989	PUTBACK;	1068	++coro_src->refcnt;
990	SAVE (aTHX_ (&temp), TRANSFER_SAVE_ALL);	1069	sv_magicext (SvRV (dst), 0, PERL_MAGIC_ext, &coro_state_vtbl, (char *)coro_src, 0)->mg_flags \|= MGf_DUP;
991	LOAD (aTHX_ coro);	1070	}
992	SPAGAIN;
993
994	destroy_stacks (aTHX);
995
996	LOAD ((&temp)); /* this will get rid of defsv etc.. */
997	SPAGAIN;
998
999	coro->mainstack = 0;
1000	}
1001
1002	deallocate_stack (coro);
1003	SvREFCNT_dec (coro->args);
1004	Safefree (coro);
1005		1071
1006	void	1072	void
1007	_exit(code)	1073	_exit (code)
1008	int code	1074	int code
1009	PROTOTYPE: $	1075	PROTOTYPE: $
1010	CODE:	1076	CODE:
1011	_exit (code);	1077	_exit (code);
1012		1078
1013	MODULE = Coro::State PACKAGE = Coro::Cont	1079	MODULE = Coro::State PACKAGE = Coro::Cont
1014		1080
1015	# this is slightly dirty (should expose a c-level api)
1016
1017	void	1081	void
1018	yield(...)	1082	yield (...)
1019	PROTOTYPE: @	1083	PROTOTYPE: @
1020	CODE:	1084	CODE:
1021	SV *yieldstack;	1085	SV *yieldstack;
1022	SV *sv;	1086	SV *sv;
1023	AV *defav = GvAV (PL_defgv);	1087	AV *defav = GvAV (PL_defgv);
…		…
1034	av_fill (defav, items - 1);	1098	av_fill (defav, items - 1);
1035	while (items--)	1099	while (items--)
1036	av_store (defav, items, SvREFCNT_inc (ST(items)));	1100	av_store (defav, items, SvREFCNT_inc (ST(items)));
1037		1101
1038	sv = av_pop ((AV *)SvRV (yieldstack));	1102	sv = av_pop ((AV *)SvRV (yieldstack));
1039	prev = INT2PTR (struct coro , SvIV ((SV)SvRV (av_fetch ((AV )SvRV (sv), 0, 0))));	1103	prev = SvSTATE ((SV)SvRV (av_fetch ((AV *)SvRV (sv), 0, 0)));
1040	next = INT2PTR (struct coro , SvIV ((SV)SvRV (av_fetch ((AV )SvRV (sv), 1, 0))));	1104	next = SvSTATE ((SV)SvRV (av_fetch ((AV *)SvRV (sv), 1, 0)));
1041	SvREFCNT_dec (sv);	1105	SvREFCNT_dec (sv);
1042		1106
1043	transfer (aTHX_ prev, next, 0);	1107	coro_state_transfer (aTHX_ prev, next, 0);
1044		1108
1045	MODULE = Coro::State PACKAGE = Coro	1109	MODULE = Coro::State PACKAGE = Coro
1046
1047	# this is slightly dirty (should expose a c-level api)
1048		1110
1049	BOOT:	1111	BOOT:
1050	{	1112	{
1051	int i;	1113	int i;
1052	HV *stash = gv_stashpv ("Coro", TRUE);	1114	HV *stash = gv_stashpv ("Coro", TRUE);
…		…
1072	coroapi.ready = api_ready;	1134	coroapi.ready = api_ready;
1073	coroapi.nready = &coro_nready;	1135	coroapi.nready = &coro_nready;
1074	coroapi.current = coro_current;	1136	coroapi.current = coro_current;
1075		1137
1076	GCoroAPI = &coroapi;	1138	GCoroAPI = &coroapi;
1077	sv_setiv(sv, (IV)&coroapi);	1139	sv_setiv (sv, (IV)&coroapi);
1078	SvREADONLY_on(sv);	1140	SvREADONLY_on (sv);
1079	}	1141	}
1080	}	1142	}
1081		1143
1082	#if !PERL_MICRO	1144	#if !PERL_MICRO
1083		1145
1084	void	1146	void
1085	ready(self)	1147	ready (self)
1086	SV * self	1148	SV * self
1087	PROTOTYPE: $	1149	PROTOTYPE: $
1088	CODE:	1150	CODE:
1089	api_ready (self);	1151	api_ready (self);
1090		1152
1091	#endif	1153	#endif
1092		1154
1093	int	1155	int
1094	nready(...)	1156	nready (...)
1095	PROTOTYPE:	1157	PROTOTYPE:
1096	CODE:	1158	CODE:
1097	RETVAL = coro_nready;	1159	RETVAL = coro_nready;
1098	OUTPUT:	1160	OUTPUT:
1099	RETVAL	1161	RETVAL
1100		1162
1101	void	1163	void
1102	schedule(...)	1164	schedule (...)
1103	PROTOTYPE:	1165	PROTOTYPE:
1104	CODE:	1166	CODE:
1105	api_schedule ();	1167	api_schedule ();
1106		1168
1107	void	1169	void
1108	cede(...)	1170	cede (...)
1109	PROTOTYPE:	1171	PROTOTYPE:
1110	CODE:	1172	CODE:
1111	api_cede ();	1173	api_cede ();
1112		1174
1113	# and these are hacks	1175	# and these are hacks

Diff Legend

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

Comparing Coro/Coro/State.xs (file contents): Revision 1.80 by root, Thu Nov 2 20:00:00 2006 UTC vs. Revision 1.87 by root, Fri Nov 24 13:40:36 2006 UTC

Diff Legend

Comparing Coro/Coro/State.xs (file contents):
Revision 1.80 by root, Thu Nov 2 20:00:00 2006 UTC vs.
Revision 1.87 by root, Fri Nov 24 13:40:36 2006 UTC