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

Comparing Coro/Coro/State.xs (file contents):
Revision 1.322 by root, Sat Nov 22 05:13:34 2008 UTC vs.
Revision 1.338 by root, Sun Dec 7 15:33:21 2008 UTC

…		…
133	#else	133	#else
134	# define dSTACKLEVEL volatile void *stacklevel	134	# define dSTACKLEVEL volatile void *stacklevel
135	# define STACKLEVEL ((void *)&stacklevel)	135	# define STACKLEVEL ((void *)&stacklevel)
136	#endif	136	#endif
137		137
138	#define IN_DESTRUCT (PL_main_cv == Nullcv)	138	#define IN_DESTRUCT PL_dirty
139		139
140	#if __GNUC__ >= 3	140	#if __GNUC__ >= 3
141	# define attribute(x) __attribute__(x)	141	# define attribute(x) __attribute__(x)
142	# define expect(expr,value) __builtin_expect ((expr),(value))	142	# define expect(expr,value) __builtin_expect ((expr),(value))
143	# define INLINE static inline	143	# define INLINE static inline
…		…
175	static HV coro_state_stash, coro_stash;	175	static HV coro_state_stash, coro_stash;
176	static volatile SV coro_mortal; / will be freed/thrown after next transfer */	176	static volatile SV coro_mortal; / will be freed/thrown after next transfer */
177		177
178	static AV av_destroy; / destruction queue */	178	static AV av_destroy; / destruction queue */
179	static SV sv_manager; / the manager coro */	179	static SV sv_manager; / the manager coro */
		180	static SV sv_idle; / $Coro::idle */
180		181
181	static GV irsgv; / $/ */	182	static GV irsgv; / $/ */
182	static GV stdoutgv; / STDOUT /	183	static GV stdoutgv; / STDOUT /
183	static SV *rv_diehook;	184	static SV *rv_diehook;
184	static SV *rv_warnhook;	185	static SV *rv_warnhook;
…		…
246	{	247	{
247	SV *defsv;	248	SV *defsv;
248	AV *defav;	249	AV *defav;
249	SV *errsv;	250	SV *errsv;
250	SV *irsgv;	251	SV *irsgv;
		252	HV *hinthv;
251	#define VAR(name,type) type name;	253	#define VAR(name,type) type name;
252	# include "state.h"	254	# include "state.h"
253	#undef VAR	255	#undef VAR
254	} perl_slots;	256	} perl_slots;
255		257
…		…
353	HV *st;	355	HV *st;
354	GV *gvp;	356	GV *gvp;
355	return sv_2cv (sv, &st, &gvp, 0);	357	return sv_2cv (sv, &st, &gvp, 0);
356	}	358	}
357		359
		360	/*****************************************************************************/
		361	/* magic glue */
		362
		363	#define CORO_MAGIC_type_cv 26
		364	#define CORO_MAGIC_type_state PERL_MAGIC_ext
		365
		366	#define CORO_MAGIC_NN(sv, type) \
		367	(expect_true (SvMAGIC (sv)->mg_type == type) \
		368	? SvMAGIC (sv) \
		369	: mg_find (sv, type))
		370
		371	#define CORO_MAGIC(sv, type) \
		372	(expect_true (SvMAGIC (sv)) \
		373	? CORO_MAGIC_NN (sv, type) \
		374	: 0)
		375
		376	#define CORO_MAGIC_cv(cv) CORO_MAGIC (((SV *)(cv)), CORO_MAGIC_type_cv)
		377	#define CORO_MAGIC_state(sv) CORO_MAGIC_NN (((SV *)(sv)), CORO_MAGIC_type_state)
		378
		379	INLINE struct coro *
		380	SvSTATE_ (pTHX_ SV *coro)
		381	{
		382	HV *stash;
		383	MAGIC *mg;
		384
		385	if (SvROK (coro))
		386	coro = SvRV (coro);
		387
		388	if (expect_false (SvTYPE (coro) != SVt_PVHV))
		389	croak ("Coro::State object required");
		390
		391	stash = SvSTASH (coro);
		392	if (expect_false (stash != coro_stash && stash != coro_state_stash))
		393	{
		394	/* very slow, but rare, check */
		395	if (!sv_derived_from (sv_2mortal (newRV_inc (coro)), "Coro::State"))
		396	croak ("Coro::State object required");
		397	}
		398
		399	mg = CORO_MAGIC_state (coro);
		400	return (struct coro *)mg->mg_ptr;
		401	}
		402
		403	#define SvSTATE(sv) SvSTATE_ (aTHX_ (sv))
		404
		405	/* faster than SvSTATE, but expects a coroutine hv */
		406	#define SvSTATE_hv(hv) ((struct coro )CORO_MAGIC_NN ((SV )hv, CORO_MAGIC_type_state)->mg_ptr)
		407	#define SvSTATE_current SvSTATE_hv (SvRV (coro_current))
		408
		409	/*****************************************************************************/
		410	/* padlist management and caching */
		411
358	static AV *	412	static AV *
359	coro_derive_padlist (pTHX_ CV *cv)	413	coro_derive_padlist (pTHX_ CV *cv)
360	{	414	{
361	AV *padlist = CvPADLIST (cv);	415	AV *padlist = CvPADLIST (cv);
362	AV newpadlist, newpad;	416	AV newpadlist, newpad;
…		…
369	Perl_pad_push (aTHX_ padlist, AvFILLp (padlist) + 1, 1);	423	Perl_pad_push (aTHX_ padlist, AvFILLp (padlist) + 1, 1);
370	#endif	424	#endif
371	newpad = (AV *)AvARRAY (padlist)[AvFILLp (padlist)];	425	newpad = (AV *)AvARRAY (padlist)[AvFILLp (padlist)];
372	--AvFILLp (padlist);	426	--AvFILLp (padlist);
373		427
374	av_store (newpadlist, 0, SvREFCNT_inc_NN (*av_fetch (padlist, 0, FALSE)));	428	av_store (newpadlist, 0, SvREFCNT_inc_NN (AvARRAY (padlist)[0]));
375	av_store (newpadlist, 1, (SV *)newpad);	429	av_store (newpadlist, 1, (SV *)newpad);
376		430
377	return newpadlist;	431	return newpadlist;
378	}	432	}
379		433
380	static void	434	static void
381	free_padlist (pTHX_ AV *padlist)	435	free_padlist (pTHX_ AV *padlist)
382	{	436	{
383	/* may be during global destruction */	437	/* may be during global destruction */
384	if (SvREFCNT (padlist))	438	if (!IN_DESTRUCT)
385	{	439	{
386	I32 i = AvFILLp (padlist);	440	I32 i = AvFILLp (padlist);
387	while (i >= 0)	441
		442	while (i > 0) /* special-case index 0 */
388	{	443	{
389	SV **svp = av_fetch (padlist, i--, FALSE);	444	/* we try to be extra-careful here */
390	if (svp)	445	AV av = (AV )AvARRAY (padlist)[i--];
391	{	446	I32 j = AvFILLp (av);
392	SV *sv;	447
393	while (&PL_sv_undef != (sv = av_pop ((AV )svp)))	448	while (j >= 0)
		449	SvREFCNT_dec (AvARRAY (av)[j--]);
		450
		451	AvFILLp (av) = -1;
394	SvREFCNT_dec (sv);	452	SvREFCNT_dec (av);
395
396	SvREFCNT_dec (*svp);
397	}
398	}	453	}
399		454
		455	SvREFCNT_dec (AvARRAY (padlist)[0]);
		456
		457	AvFILLp (padlist) = -1;
400	SvREFCNT_dec ((SV*)padlist);	458	SvREFCNT_dec ((SV*)padlist);
401	}	459	}
402	}	460	}
403		461
404	static int	462	static int
…		…
413		471
414	SvREFCNT_dec (av); /* sv_magicext increased the refcount */	472	SvREFCNT_dec (av); /* sv_magicext increased the refcount */
415		473
416	return 0;	474	return 0;
417	}	475	}
418
419	#define CORO_MAGIC_type_cv 26
420	#define CORO_MAGIC_type_state PERL_MAGIC_ext
421		476
422	static MGVTBL coro_cv_vtbl = {	477	static MGVTBL coro_cv_vtbl = {
423	0, 0, 0, 0,	478	0, 0, 0, 0,
424	coro_cv_free	479	coro_cv_free
425	};	480	};
426
427	#define CORO_MAGIC_NN(sv, type) \
428	(expect_true (SvMAGIC (sv)->mg_type == type) \
429	? SvMAGIC (sv) \
430	: mg_find (sv, type))
431
432	#define CORO_MAGIC(sv, type) \
433	(expect_true (SvMAGIC (sv)) \
434	? CORO_MAGIC_NN (sv, type) \
435	: 0)
436
437	#define CORO_MAGIC_cv(cv) CORO_MAGIC (((SV *)(cv)), CORO_MAGIC_type_cv)
438	#define CORO_MAGIC_state(sv) CORO_MAGIC_NN (((SV *)(sv)), CORO_MAGIC_type_state)
439
440	INLINE struct coro *
441	SvSTATE_ (pTHX_ SV *coro)
442	{
443	HV *stash;
444	MAGIC *mg;
445
446	if (SvROK (coro))
447	coro = SvRV (coro);
448
449	if (expect_false (SvTYPE (coro) != SVt_PVHV))
450	croak ("Coro::State object required");
451
452	stash = SvSTASH (coro);
453	if (expect_false (stash != coro_stash && stash != coro_state_stash))
454	{
455	/* very slow, but rare, check */
456	if (!sv_derived_from (sv_2mortal (newRV_inc (coro)), "Coro::State"))
457	croak ("Coro::State object required");
458	}
459
460	mg = CORO_MAGIC_state (coro);
461	return (struct coro *)mg->mg_ptr;
462	}
463
464	#define SvSTATE(sv) SvSTATE_ (aTHX_ (sv))
465
466	/* faster than SvSTATE, but expects a coroutine hv */
467	#define SvSTATE_hv(hv) ((struct coro )CORO_MAGIC_NN ((SV )hv, CORO_MAGIC_type_state)->mg_ptr)
468	#define SvSTATE_current SvSTATE_hv (SvRV (coro_current))
469		481
470	/* the next two functions merely cache the padlists */	482	/* the next two functions merely cache the padlists */
471	static void	483	static void
472	get_padlist (pTHX_ CV *cv)	484	get_padlist (pTHX_ CV *cv)
473	{	485	{
…		…
501	mg = sv_magicext ((SV )cv, (SV )newAV (), CORO_MAGIC_type_cv, &coro_cv_vtbl, 0, 0);	513	mg = sv_magicext ((SV )cv, (SV )newAV (), CORO_MAGIC_type_cv, &coro_cv_vtbl, 0, 0);
502		514
503	av = (AV *)mg->mg_obj;	515	av = (AV *)mg->mg_obj;
504		516
505	if (expect_false (AvFILLp (av) >= AvMAX (av)))	517	if (expect_false (AvFILLp (av) >= AvMAX (av)))
506	av_extend (av, AvMAX (av) + 1);	518	av_extend (av, AvFILLp (av) + 1);
507		519
508	AvARRAY (av)[++AvFILLp (av)] = (SV *)CvPADLIST (cv);	520	AvARRAY (av)[++AvFILLp (av)] = (SV *)CvPADLIST (cv);
509	}	521	}
510		522
511	/ load & save, init *****************************************************/	523	/ load & save, init *****************************************************/
…		…
516	perl_slots *slot = c->slot;	528	perl_slots *slot = c->slot;
517	c->slot = 0;	529	c->slot = 0;
518		530
519	PL_mainstack = c->mainstack;	531	PL_mainstack = c->mainstack;
520		532
521	GvSV (PL_defgv) = slot->defsv;	533	GvSV (PL_defgv) = slot->defsv;
522	GvAV (PL_defgv) = slot->defav;	534	GvAV (PL_defgv) = slot->defav;
523	GvSV (PL_errgv) = slot->errsv;	535	GvSV (PL_errgv) = slot->errsv;
524	GvSV (irsgv) = slot->irsgv;	536	GvSV (irsgv) = slot->irsgv;
		537	GvHV (PL_hintgv) = slot->hinthv;
525		538
526	#define VAR(name,type) PL_ ## name = slot->name;	539	#define VAR(name,type) PL_ ## name = slot->name;
527	# include "state.h"	540	# include "state.h"
528	#undef VAR	541	#undef VAR
529		542
…		…
615	c->mainstack = PL_mainstack;	628	c->mainstack = PL_mainstack;
616		629
617	{	630	{
618	perl_slots slot = c->slot = (perl_slots )(cxstack + cxstack_ix + 1);	631	perl_slots slot = c->slot = (perl_slots )(cxstack + cxstack_ix + 1);
619		632
620	slot->defav = GvAV (PL_defgv);	633	slot->defav = GvAV (PL_defgv);
621	slot->defsv = DEFSV;	634	slot->defsv = DEFSV;
622	slot->errsv = ERRSV;	635	slot->errsv = ERRSV;
623	slot->irsgv = GvSV (irsgv);	636	slot->irsgv = GvSV (irsgv);
		637	slot->hinthv = GvHV (PL_hintgv);
624		638
625	#define VAR(name,type) slot->name = PL_ ## name;	639	#define VAR(name,type) slot->name = PL_ ## name;
626	# include "state.h"	640	# include "state.h"
627	#undef VAR	641	#undef VAR
628	}	642	}
…		…
755	#endif	769	#endif
756		770
757	/*	771	/*
758	* This overrides the default magic get method of %SIG elements.	772	* This overrides the default magic get method of %SIG elements.
759	* The original one doesn't provide for reading back of PL_diehook/PL_warnhook	773	* The original one doesn't provide for reading back of PL_diehook/PL_warnhook
760	* and instead of tryign to save and restore the hash elements, we just provide	774	* and instead of trying to save and restore the hash elements, we just provide
761	* readback here.	775	* readback here.
762	* We only do this when the hook is != 0, as they are often set to 0 temporarily,
763	* not expecting this to actually change the hook. This is a potential problem
764	* when a schedule happens then, but we ignore this.
765	*/	776	*/
766	static int	777	static int
767	coro_sigelem_get (pTHX_ SV sv, MAGIC mg)	778	coro_sigelem_get (pTHX_ SV sv, MAGIC mg)
768	{	779	{
769	const char *s = MgPV_nolen_const (mg);	780	const char *s = MgPV_nolen_const (mg);
…		…
822	if (strEQ (s, "__WARN__")) svp = &PL_warnhook;	833	if (strEQ (s, "__WARN__")) svp = &PL_warnhook;
823		834
824	if (svp)	835	if (svp)
825	{	836	{
826	SV old = svp;	837	SV old = svp;
827	*svp = newSVsv (sv);	838	*svp = SvOK (sv) ? newSVsv (sv) : 0;
828	SvREFCNT_dec (old);	839	SvREFCNT_dec (old);
829	return 0;	840	return 0;
830	}	841	}
831	}	842	}
832		843
…		…
864		875
865	PL_runops = RUNOPS_DEFAULT;	876	PL_runops = RUNOPS_DEFAULT;
866	PL_curcop = &PL_compiling;	877	PL_curcop = &PL_compiling;
867	PL_in_eval = EVAL_NULL;	878	PL_in_eval = EVAL_NULL;
868	PL_comppad = 0;	879	PL_comppad = 0;
		880	PL_comppad_name = 0;
		881	PL_comppad_name_fill = 0;
		882	PL_comppad_name_floor = 0;
869	PL_curpm = 0;	883	PL_curpm = 0;
870	PL_curpad = 0;	884	PL_curpad = 0;
871	PL_localizing = 0;	885	PL_localizing = 0;
872	PL_dirty = 0;	886	PL_dirty = 0;
873	PL_restartop = 0;	887	PL_restartop = 0;
874	#if PERL_VERSION_ATLEAST (5,10,0)	888	#if PERL_VERSION_ATLEAST (5,10,0)
875	PL_parser = 0;	889	PL_parser = 0;
876	#endif	890	#endif
		891	PL_hints = 0;
877		892
878	/* recreate the die/warn hooks */	893	/* recreate the die/warn hooks */
879	PL_diehook = 0; SvSetMagicSV (*hv_fetch (hv_sig, "__DIE__" , sizeof ("__DIE__" ) - 1, 1), rv_diehook );	894	PL_diehook = 0; SvSetMagicSV (*hv_fetch (hv_sig, "__DIE__" , sizeof ("__DIE__" ) - 1, 1), rv_diehook );
880	PL_warnhook = 0; SvSetMagicSV (*hv_fetch (hv_sig, "__WARN__", sizeof ("__WARN__") - 1, 1), rv_warnhook);	895	PL_warnhook = 0; SvSetMagicSV (*hv_fetch (hv_sig, "__WARN__", sizeof ("__WARN__") - 1, 1), rv_warnhook);
881		896
882	GvSV (PL_defgv) = newSV (0);	897	GvSV (PL_defgv) = newSV (0);
883	GvAV (PL_defgv) = coro->args; coro->args = 0;	898	GvAV (PL_defgv) = coro->args; coro->args = 0;
884	GvSV (PL_errgv) = newSV (0);	899	GvSV (PL_errgv) = newSV (0);
885	GvSV (irsgv) = newSVpvn ("\n", 1); sv_magic (GvSV (irsgv), (SV *)irsgv, PERL_MAGIC_sv, "/", 0);	900	GvSV (irsgv) = newSVpvn ("\n", 1); sv_magic (GvSV (irsgv), (SV *)irsgv, PERL_MAGIC_sv, "/", 0);
		901	GvHV (PL_hintgv) = 0;
886	PL_rs = newSVsv (GvSV (irsgv));	902	PL_rs = newSVsv (GvSV (irsgv));
887	PL_defoutgv = (GV *)SvREFCNT_inc_NN (stdoutgv);	903	PL_defoutgv = (GV *)SvREFCNT_inc_NN (stdoutgv);
888		904
889	{	905	{
890	dSP;	906	dSP;
…		…
919	/* copy throw, in case it was set before coro_setup */	935	/* copy throw, in case it was set before coro_setup */
920	CORO_THROW = coro->except;	936	CORO_THROW = coro->except;
921	}	937	}
922		938
923	static void	939	static void
924	coro_destruct (pTHX_ struct coro *coro)	940	coro_unwind_stacks (pTHX)
925	{	941	{
926	if (!IN_DESTRUCT)	942	if (!IN_DESTRUCT)
927	{	943	{
928	/* restore all saved variables and stuff */	944	/* restore all saved variables and stuff */
929	LEAVE_SCOPE (0);	945	LEAVE_SCOPE (0);
…		…
937	POPSTACK_TO (PL_mainstack);	953	POPSTACK_TO (PL_mainstack);
938		954
939	/* unwind main stack */	955	/* unwind main stack */
940	dounwind (-1);	956	dounwind (-1);
941	}	957	}
		958	}
		959
		960	static void
		961	coro_destruct_perl (pTHX_ struct coro *coro)
		962	{
		963	coro_unwind_stacks (aTHX);
942		964
943	SvREFCNT_dec (GvSV (PL_defgv));	965	SvREFCNT_dec (GvSV (PL_defgv));
944	SvREFCNT_dec (GvAV (PL_defgv));	966	SvREFCNT_dec (GvAV (PL_defgv));
945	SvREFCNT_dec (GvSV (PL_errgv));	967	SvREFCNT_dec (GvSV (PL_errgv));
946	SvREFCNT_dec (PL_defoutgv);	968	SvREFCNT_dec (PL_defoutgv);
947	SvREFCNT_dec (PL_rs);	969	SvREFCNT_dec (PL_rs);
948	SvREFCNT_dec (GvSV (irsgv));	970	SvREFCNT_dec (GvSV (irsgv));
		971	SvREFCNT_dec (GvHV (PL_hintgv));
949		972
950	SvREFCNT_dec (PL_diehook);	973	SvREFCNT_dec (PL_diehook);
951	SvREFCNT_dec (PL_warnhook);	974	SvREFCNT_dec (PL_warnhook);
952		975
953	SvREFCNT_dec (coro->saved_deffh);	976	SvREFCNT_dec (coro->saved_deffh);
…		…
971	static int	994	static int
972	runops_trace (pTHX)	995	runops_trace (pTHX)
973	{	996	{
974	COP *oldcop = 0;	997	COP *oldcop = 0;
975	int oldcxix = -2;	998	int oldcxix = -2;
976	struct coro coro = SvSTATE_current; / trace cctx is tied to specific coro */
977	coro_cctx *cctx = coro->cctx;
978		999
979	while ((PL_op = CALL_FPTR (PL_op->op_ppaddr) (aTHX)))	1000	while ((PL_op = CALL_FPTR (PL_op->op_ppaddr) (aTHX)))
980	{	1001	{
981	PERL_ASYNC_CHECK ();	1002	PERL_ASYNC_CHECK ();
982		1003
983	if (cctx->flags & CC_TRACE_ALL)	1004	if (cctx_current->flags & CC_TRACE_ALL)
984	{	1005	{
985	if (PL_op->op_type == OP_LEAVESUB && cctx->flags & CC_TRACE_SUB)	1006	if (PL_op->op_type == OP_LEAVESUB && cctx_current->flags & CC_TRACE_SUB)
986	{	1007	{
987	PERL_CONTEXT *cx = &cxstack[cxstack_ix];	1008	PERL_CONTEXT *cx = &cxstack[cxstack_ix];
988	SV bot, top;	1009	SV bot, top;
989	AV av = newAV (); / return values */	1010	AV av = newAV (); / return values */
990	SV **cb;	1011	SV **cb;
…		…
1027		1048
1028	if (PL_curcop != &PL_compiling)	1049	if (PL_curcop != &PL_compiling)
1029	{	1050	{
1030	SV **cb;	1051	SV **cb;
1031		1052
1032	if (oldcxix != cxstack_ix && cctx->flags & CC_TRACE_SUB)	1053	if (oldcxix != cxstack_ix && cctx_current->flags & CC_TRACE_SUB)
1033	{	1054	{
1034	PERL_CONTEXT *cx = &cxstack[cxstack_ix];	1055	PERL_CONTEXT *cx = &cxstack[cxstack_ix];
1035		1056
1036	if (CxTYPE (cx) == CXt_SUB && oldcxix < cxstack_ix)	1057	if (CxTYPE (cx) == CXt_SUB && oldcxix < cxstack_ix)
1037	{	1058	{
…		…
1060	}	1081	}
1061		1082
1062	oldcxix = cxstack_ix;	1083	oldcxix = cxstack_ix;
1063	}	1084	}
1064		1085
1065	if (cctx->flags & CC_TRACE_LINE)	1086	if (cctx_current->flags & CC_TRACE_LINE)
1066	{	1087	{
1067	dSP;	1088	dSP;
1068		1089
1069	PL_runops = RUNOPS_DEFAULT;	1090	PL_runops = RUNOPS_DEFAULT;
1070	ENTER;	1091	ENTER;
…		…
1170	/*	1191	/*
1171	* If perl-run returns we assume exit() was being called or the coro	1192	* If perl-run returns we assume exit() was being called or the coro
1172	* fell off the end, which seems to be the only valid (non-bug)	1193	* fell off the end, which seems to be the only valid (non-bug)
1173	* reason for perl_run to return. We try to exit by jumping to the	1194	* reason for perl_run to return. We try to exit by jumping to the
1174	* bootstrap-time "top" top_env, as we cannot restore the "main"	1195	* bootstrap-time "top" top_env, as we cannot restore the "main"
1175	* coroutine as Coro has no such concept	1196	* coroutine as Coro has no such concept.
		1197	* This actually isn't valid with the pthread backend, but OSes requiring
		1198	* that backend are too broken to do it in a standards-compliant way.
1176	*/	1199	*/
1177	PL_top_env = main_top_env;	1200	PL_top_env = main_top_env;
1178	JMPENV_JUMP (2); /* I do not feel well about the hardcoded 2 at all */	1201	JMPENV_JUMP (2); /* I do not feel well about the hardcoded 2 at all */
1179	}	1202	}
1180	}	1203	}
…		…
1257	cctx_destroy (coro_cctx *cctx)	1280	cctx_destroy (coro_cctx *cctx)
1258	{	1281	{
1259	if (!cctx)	1282	if (!cctx)
1260	return;	1283	return;
1261		1284
1262	assert (cctx != cctx_current);//D temporary	1285	assert (("FATAL: tried to destroy current cctx", cctx != cctx_current));//D temporary?
1263		1286
1264	--cctx_count;	1287	--cctx_count;
1265	coro_destroy (&cctx->cctx);	1288	coro_destroy (&cctx->cctx);
1266		1289
1267	/* coro_transfer creates new, empty cctx's */	1290	/* coro_transfer creates new, empty cctx's */
…		…
1331	/* TODO: throwing up here is considered harmful */	1354	/* TODO: throwing up here is considered harmful */
1332		1355
1333	if (expect_true (prev != next))	1356	if (expect_true (prev != next))
1334	{	1357	{
1335	if (expect_false (!(prev->flags & (CF_RUNNING \| CF_NEW))))	1358	if (expect_false (!(prev->flags & (CF_RUNNING \| CF_NEW))))
1336	croak ("Coro::State::transfer called with non-running/new prev Coro::State, but can only transfer from running or new states,");	1359	croak ("Coro::State::transfer called with a suspended prev Coro::State, but can only transfer from running or new states,");
1337		1360
1338	if (expect_false (next->flags & CF_RUNNING))	1361	if (expect_false (next->flags & CF_RUNNING))
1339	croak ("Coro::State::transfer called with running next Coro::State, but can only transfer to inactive states,");	1362	croak ("Coro::State::transfer called with running next Coro::State, but can only transfer to inactive states,");
1340		1363
1341	if (expect_false (next->flags & CF_DESTROYED))	1364	if (expect_false (next->flags & CF_DESTROYED))
…		…
1395	))	1418	))
1396	{	1419	{
1397	/* I assume that stacklevel is a stronger indicator than PL_top_env changes */	1420	/* I assume that stacklevel is a stronger indicator than PL_top_env changes */
1398	assert (("FATAL: current top_env must equal previous top_env in Coro (please report)", PL_top_env == cctx_current->idle_te));	1421	assert (("FATAL: current top_env must equal previous top_env in Coro (please report)", PL_top_env == cctx_current->idle_te));
1399		1422
1400	/* if the cctx is about to be destroyed we need to make sure we won't see it in cctx_get */	1423	/* if the cctx is about to be destroyed we need to make sure we won't see it in cctx_get. */
1401	/* without this the next cctx_get might destroy the prev__cctx while still in use */	1424	/* without this the next cctx_get might destroy the running cctx while still in use */
1402	if (expect_false (CCTX_EXPIRED (cctx_current)))	1425	if (expect_false (CCTX_EXPIRED (cctx_current)))
1403	if (!next->cctx)	1426	if (expect_true (!next->cctx))
1404	next->cctx = cctx_get (aTHX);	1427	next->cctx = cctx_get (aTHX);
1405		1428
1406	cctx_put (cctx_current);	1429	cctx_put (cctx_current);
1407	assert (!prev->cctx);//D temporary
1408	}	1430	}
1409	else	1431	else
1410	prev->cctx = cctx_current;	1432	prev->cctx = cctx_current;
1411		1433
1412	++next->usecount;	1434	++next->usecount;
…		…
1450	--coro_nready;	1472	--coro_nready;
1451	}	1473	}
1452	else	1474	else
1453	coro->flags \|= CF_READY; /* make sure it is NOT put into the readyqueue */	1475	coro->flags \|= CF_READY; /* make sure it is NOT put into the readyqueue */
1454		1476
1455	if (coro->mainstack && coro->mainstack != main_mainstack)	1477	if (coro->mainstack
		1478	&& coro->mainstack != main_mainstack
		1479	&& coro->slot
		1480	&& !PL_dirty)
1456	{	1481	{
1457	struct coro temp;	1482	struct coro temp;
1458		1483
1459	assert (("FATAL: tried to destroy currently running coroutine (please report)", !(coro->flags & CF_RUNNING)));	1484	assert (("FATAL: tried to destroy currently running coroutine", coro->mainstack != PL_mainstack));
1460		1485
1461	save_perl (aTHX_ &temp);	1486	save_perl (aTHX_ &temp);
1462	load_perl (aTHX_ coro);	1487	load_perl (aTHX_ coro);
1463		1488
1464	coro_destruct (aTHX_ coro);	1489	coro_destruct_perl (aTHX_ coro);
1465		1490
1466	load_perl (aTHX_ &temp);	1491	load_perl (aTHX_ &temp);
1467		1492
1468	coro->slot = 0;	1493	coro->slot = 0;
1469	}	1494	}
…		…
1583	{	1608	{
1584	struct coro *coro;	1609	struct coro *coro;
1585	SV *sv_hook;	1610	SV *sv_hook;
1586	void (*xs_hook)(void);	1611	void (*xs_hook)(void);
1587		1612
1588	if (SvROK (coro_sv))
1589	coro_sv = SvRV (coro_sv);
1590
1591	coro = SvSTATE (coro_sv);	1613	coro = SvSTATE (coro_sv);
1592		1614
1593	if (coro->flags & CF_READY)	1615	if (coro->flags & CF_READY)
1594	return 0;	1616	return 0;
1595		1617
…		…
1669	}	1691	}
1670	}	1692	}
1671	else	1693	else
1672	{	1694	{
1673	/* nothing to schedule: call the idle handler */	1695	/* nothing to schedule: call the idle handler */
		1696	if (SvROK (sv_idle)
		1697	&& SvOBJECT (SvRV (sv_idle)))
		1698	{
		1699	++coro_nready; /* hack so that api_ready doesn't invoke ready hook */
		1700	api_ready (aTHX_ SvRV (sv_idle));
		1701	--coro_nready;
		1702	}
		1703	else
		1704	{
1674	dSP;	1705	dSP;
1675		1706
1676	ENTER;	1707	ENTER;
1677	SAVETMPS;	1708	SAVETMPS;
1678		1709
1679	PUSHMARK (SP);	1710	PUSHMARK (SP);
1680	PUTBACK;	1711	PUTBACK;
1681	call_sv (get_sv ("Coro::idle", FALSE), G_VOID \| G_DISCARD);	1712	call_sv (sv_idle, G_VOID \| G_DISCARD);
1682		1713
1683	FREETMPS;	1714	FREETMPS;
1684	LEAVE;	1715	LEAVE;
		1716	}
1685	}	1717	}
1686	}	1718	}
1687	}	1719	}
1688		1720
1689	INLINE void	1721	INLINE void
…		…
1760	static void	1792	static void
1761	api_trace (pTHX_ SV *coro_sv, int flags)	1793	api_trace (pTHX_ SV *coro_sv, int flags)
1762	{	1794	{
1763	struct coro *coro = SvSTATE (coro_sv);	1795	struct coro *coro = SvSTATE (coro_sv);
1764		1796
		1797	if (coro->flags & CF_RUNNING)
		1798	croak ("cannot enable tracing on a running coroutine, caught");
		1799
1765	if (flags & CC_TRACE)	1800	if (flags & CC_TRACE)
1766	{	1801	{
1767	if (!coro->cctx)	1802	if (!coro->cctx)
1768	coro->cctx = cctx_new_run ();	1803	coro->cctx = cctx_new_run ();
1769	else if (!(coro->cctx->flags & CC_TRACE))	1804	else if (!(coro->cctx->flags & CC_TRACE))
1770	croak ("cannot enable tracing on coroutine with custom stack,");	1805	croak ("cannot enable tracing on coroutine with custom stack, caught");
1771		1806
1772	coro->cctx->flags \|= CC_NOREUSE \| (flags & (CC_TRACE \| CC_TRACE_ALL));	1807	coro->cctx->flags \|= CC_NOREUSE \| (flags & (CC_TRACE \| CC_TRACE_ALL));
1773	}	1808	}
1774	else if (coro->cctx && coro->cctx->flags & CC_TRACE)	1809	else if (coro->cctx && coro->cctx->flags & CC_TRACE)
1775	{	1810	{
…		…
1831	av_push (av_destroy, (SV )newRV_inc ((SV )hv)); /* RVinc for perl */	1866	av_push (av_destroy, (SV )newRV_inc ((SV )hv)); /* RVinc for perl */
1832	api_ready (aTHX_ sv_manager);	1867	api_ready (aTHX_ sv_manager);
1833		1868
1834	frame->prepare = prepare_schedule;	1869	frame->prepare = prepare_schedule;
1835	frame->check = slf_check_repeat;	1870	frame->check = slf_check_repeat;
		1871
		1872	/* as a minor optimisation, we could unwind all stacks here */
		1873	/* but that puts extra pressure on pp_slf, and is not worth much */
		1874	/coro_unwind_stacks (aTHX);/
1836	}	1875	}
1837		1876
1838	/*****************************************************************************/	1877	/*****************************************************************************/
1839	/* async pool handler */	1878	/* async pool handler */
1840		1879
…		…
2349	SV **ary;	2388	SV **ary;
2350		2389
2351	/* unfortunately, building manually saves memory */	2390	/* unfortunately, building manually saves memory */
2352	Newx (ary, 2, SV *);	2391	Newx (ary, 2, SV *);
2353	AvALLOC (av) = ary;	2392	AvALLOC (av) = ary;
		2393	#if PERL_VERSION_ATLEAST (5,10,0)
2354	/AvARRAY (av) = ary;/	2394	AvARRAY (av) = ary;
		2395	#else
2355	SvPVX ((SV )av) = (char )ary; /* 5.8.8 needs this syntax instead of AvARRAY = ary */	2396	/* 5.8.8 needs this syntax instead of AvARRAY = ary, yet */
		2397	/* -DDEBUGGING flags this as a bug, despite it perfectly working */
		2398	SvPVX ((SV )av) = (char )ary;
		2399	#endif
2356	AvMAX (av) = 1;	2400	AvMAX (av) = 1;
2357	AvFILLp (av) = 0;	2401	AvFILLp (av) = 0;
2358	ary [0] = newSViv (count);	2402	ary [0] = newSViv (count);
2359		2403
2360	return newRV_noinc ((SV *)av);	2404	return newRV_noinc ((SV *)av);
…		…
2889	SV *	2933	SV *
2890	clone (Coro::State coro)	2934	clone (Coro::State coro)
2891	CODE:	2935	CODE:
2892	{	2936	{
2893	#if CORO_CLONE	2937	#if CORO_CLONE
2894	struct coro *ncoro = coro_clone (coro);	2938	struct coro *ncoro = coro_clone (aTHX_ coro);
2895	MAGIC *mg;	2939	MAGIC *mg;
2896	/* TODO: too much duplication */	2940	/* TODO: too much duplication */
2897	ncoro->hv = newHV ();	2941	ncoro->hv = newHV ();
2898	mg = sv_magicext ((SV )ncoro->hv, 0, CORO_MAGIC_type_state, &coro_state_vtbl, (char )ncoro, 0);	2942	mg = sv_magicext ((SV )ncoro->hv, 0, CORO_MAGIC_type_state, &coro_state_vtbl, (char )ncoro, 0);
2899	mg->mg_flags \|= MGf_DUP;	2943	mg->mg_flags \|= MGf_DUP;
…		…
3032		3076
3033	SV *	3077	SV *
3034	has_cctx (Coro::State coro)	3078	has_cctx (Coro::State coro)
3035	PROTOTYPE: $	3079	PROTOTYPE: $
3036	CODE:	3080	CODE:
3037	RETVAL = boolSV (!!coro->cctx);	3081	/* maybe manage the running flag differently */
		3082	RETVAL = boolSV (!!coro->cctx \|\| (coro->flags & CF_RUNNING));
3038	OUTPUT:	3083	OUTPUT:
3039	RETVAL	3084	RETVAL
3040		3085
3041	int	3086	int
3042	is_traced (Coro::State coro)	3087	is_traced (Coro::State coro)
…		…
3062		3107
3063	void	3108	void
3064	force_cctx ()	3109	force_cctx ()
3065	PROTOTYPE:	3110	PROTOTYPE:
3066	CODE:	3111	CODE:
3067	SvSTATE_current->cctx->idle_sp = 0;	3112	cctx_current->idle_sp = 0;
3068		3113
3069	void	3114	void
3070	swap_defsv (Coro::State self)	3115	swap_defsv (Coro::State self)
3071	PROTOTYPE: $	3116	PROTOTYPE: $
3072	ALIAS:	3117	ALIAS:
…		…
3089	{	3134	{
3090	int i;	3135	int i;
3091		3136
3092	sv_pool_rss = coro_get_sv (aTHX_ "Coro::POOL_RSS" , TRUE);	3137	sv_pool_rss = coro_get_sv (aTHX_ "Coro::POOL_RSS" , TRUE);
3093	sv_pool_size = coro_get_sv (aTHX_ "Coro::POOL_SIZE" , TRUE);	3138	sv_pool_size = coro_get_sv (aTHX_ "Coro::POOL_SIZE" , TRUE);
3094	cv_coro_run = get_cv ( "Coro::_terminate", GV_ADD);	3139	cv_coro_run = get_cv ( "Coro::_coro_run" , GV_ADD);
3095	cv_coro_terminate = get_cv ( "Coro::terminate" , GV_ADD);	3140	cv_coro_terminate = get_cv ( "Coro::terminate" , GV_ADD);
3096	coro_current = coro_get_sv (aTHX_ "Coro::current" , FALSE); SvREADONLY_on (coro_current);	3141	coro_current = coro_get_sv (aTHX_ "Coro::current" , FALSE); SvREADONLY_on (coro_current);
3097	av_async_pool = coro_get_av (aTHX_ "Coro::async_pool", TRUE);	3142	av_async_pool = coro_get_av (aTHX_ "Coro::async_pool", TRUE);
3098	av_destroy = coro_get_av (aTHX_ "Coro::destroy" , TRUE);	3143	av_destroy = coro_get_av (aTHX_ "Coro::destroy" , TRUE);
3099	sv_manager = coro_get_sv (aTHX_ "Coro::manager" , TRUE);	3144	sv_manager = coro_get_sv (aTHX_ "Coro::manager" , TRUE);
		3145	sv_idle = coro_get_sv (aTHX_ "Coro::idle" , TRUE);
3100		3146
3101	sv_async_pool_idle = newSVpv ("[async pool idle]", 0); SvREADONLY_on (sv_async_pool_idle);	3147	sv_async_pool_idle = newSVpv ("[async pool idle]", 0); SvREADONLY_on (sv_async_pool_idle);
3102	sv_Coro = newSVpv ("Coro", 0); SvREADONLY_on (sv_Coro);	3148	sv_Coro = newSVpv ("Coro", 0); SvREADONLY_on (sv_Coro);
3103	cv_pool_handler = get_cv ("Coro::pool_handler", GV_ADD); SvREADONLY_on (cv_pool_handler);	3149	cv_pool_handler = get_cv ("Coro::pool_handler", GV_ADD); SvREADONLY_on (cv_pool_handler);
3104	cv_coro_state_new = get_cv ("Coro::State::new", 0); SvREADONLY_on (cv_coro_state_new);	3150	cv_coro_state_new = get_cv ("Coro::State::new", 0); SvREADONLY_on (cv_coro_state_new);

Diff Legend

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

Comparing Coro/Coro/State.xs (file contents): Revision 1.322 by root, Sat Nov 22 05:13:34 2008 UTC vs. Revision 1.338 by root, Sun Dec 7 15:33:21 2008 UTC

Diff Legend

Comparing Coro/Coro/State.xs (file contents):
Revision 1.322 by root, Sat Nov 22 05:13:34 2008 UTC vs.
Revision 1.338 by root, Sun Dec 7 15:33:21 2008 UTC