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

Comparing Coro/Coro/State.xs (file contents):
Revision 1.168 by root, Thu Sep 27 16:10:48 2007 UTC vs.
Revision 1.184 by root, Thu Oct 4 13:45:56 2007 UTC

…		…
132	static AV main_mainstack; / used to differentiate between $main and others */	132	static AV main_mainstack; / used to differentiate between $main and others */
133	static JMPENV *main_top_env;	133	static JMPENV *main_top_env;
134	static HV coro_state_stash, coro_stash;	134	static HV coro_state_stash, coro_stash;
135	static SV coro_mortal; / will be freed after next transfer */	135	static SV coro_mortal; / will be freed after next transfer */
136		136
		137	static GV irsgv; / $/ */
		138
137	/* async_pool helper stuff */	139	/* async_pool helper stuff */
138	static SV *sv_pool_rss;	140	static SV *sv_pool_rss;
139	static SV *sv_pool_size;	141	static SV *sv_pool_size;
140	static AV *av_async_pool;	142	static AV *av_async_pool;
141		143
…		…
184	coro_cctx *cctx;	186	coro_cctx *cctx;
185		187
186	/* data associated with this coroutine (initial args) */	188	/* data associated with this coroutine (initial args) */
187	AV *args;	189	AV *args;
188	int refcnt;	190	int refcnt;
189	int save; /* CORO_SAVE flags */
190	int flags; /* CF_ flags */	191	int flags; /* CF_ flags */
191		192
192	/* optionally saved, might be zero */	193	/* optionally saved, might be zero */
193	AV defav; / @_ */	194	AV defav; / @_ */
194	SV defsv; / $_ */	195	SV defsv; / $_ */
195	SV errsv; / $@ */	196	SV errsv; / $@ */
196	GV deffh; / default filehandle */	197	SV deffh; / default filehandle */
197	SV irssv; / $/ */	198	SV irssv; / $/ */
198	SV irssv_sv; / real $/ cache */	199	SV irssv_sv; / real $/ cache */
199		200
200	#define VAR(name,type) type name;	201	#define VAR(name,type) type name;
201	# include "state.h"	202	# include "state.h"
202	#undef VAR	203	#undef VAR
203		204
		205	/* statistics */
		206	int usecount; /* number of transfers to this coro */
		207
204	/* coro process data */	208	/* coro process data */
205	int prio;	209	int prio;
		210	//SV *throw;
		211
		212	/* async_pool */
		213	SV *saved_deffh;
206		214
207	/* linked list */	215	/* linked list */
208	struct coro next, prev;	216	struct coro next, prev;
209	HV hv; / the perl hash associated with this coro, if any */	217	HV hv; / the perl hash associated with this coro, if any */
210	};	218	};
…		…
298	SvMAGIC (cv) \	306	SvMAGIC (cv) \
299	? SvMAGIC (cv)->mg_type == PERL_MAGIC_coro \	307	? SvMAGIC (cv)->mg_type == PERL_MAGIC_coro \
300	? SvMAGIC (cv) \	308	? SvMAGIC (cv) \
301	: mg_find ((SV *)cv, PERL_MAGIC_coro) \	309	: mg_find ((SV *)cv, PERL_MAGIC_coro) \
302	: 0	310	: 0
		311
		312	static struct coro *
		313	SvSTATE_ (pTHX_ SV *coro)
		314	{
		315	HV *stash;
		316	MAGIC *mg;
		317
		318	if (SvROK (coro))
		319	coro = SvRV (coro);
		320
		321	if (SvTYPE (coro) != SVt_PVHV)
		322	croak ("Coro::State object required");
		323
		324	stash = SvSTASH (coro);
		325	if (stash != coro_stash && stash != coro_state_stash)
		326	{
		327	/* very slow, but rare, check */
		328	if (!sv_derived_from (sv_2mortal (newRV_inc (coro)), "Coro::State"))
		329	croak ("Coro::State object required");
		330	}
		331
		332	mg = CORO_MAGIC (coro);
		333	return (struct coro *)mg->mg_ptr;
		334	}
		335
		336	#define SvSTATE(sv) SvSTATE_ (aTHX_ (sv))
303		337
304	/* the next two functions merely cache the padlists */	338	/* the next two functions merely cache the padlists */
305	static void	339	static void
306	get_padlist (pTHX_ CV *cv)	340	get_padlist (pTHX_ CV *cv)
307	{	341	{
…		…
346	AvARRAY (av)[++AvFILLp (av)] = (SV *)CvPADLIST (cv);	380	AvARRAY (av)[++AvFILLp (av)] = (SV *)CvPADLIST (cv);
347	}	381	}
348		382
349	/ load & save, init *****************************************************/	383	/ load & save, init *****************************************************/
350		384
351	#define SB do {
352	#define SE } while (0)
353
354	#define REPLACE_SV(sv,val) SB SvREFCNT_dec (sv); (sv) = (val); (val) = 0; SE
355
356	static void	385	static void
357	load_perl (pTHX_ Coro__State c)	386	load_perl (pTHX_ Coro__State c)
358	{	387	{
359	#define VAR(name,type) PL_ ## name = c->name;	388	#define VAR(name,type) PL_ ## name = c->name;
360	# include "state.h"	389	# include "state.h"
361	#undef VAR	390	#undef VAR
362		391
363	if (c->defav) REPLACE_SV (GvAV (PL_defgv), c->defav);	392	GvSV (PL_defgv) = c->defsv;
364	if (c->defsv) REPLACE_SV (DEFSV , c->defsv);	393	GvAV (PL_defgv) = c->defav;
365	if (c->errsv) REPLACE_SV (ERRSV , c->errsv);	394	GvSV (PL_errgv) = c->errsv;
366	if (c->deffh) REPLACE_SV (PL_defoutgv , c->deffh);	395	GvSV (irsgv) = c->irssv_sv;
367
368	if (c->irssv)
369	{
370	if (c->irssv == PL_rs \|\| sv_eq (PL_rs, c->irssv))
371	{
372	SvREFCNT_dec (c->irssv);
373	c->irssv = 0;
374	}
375	else
376	{
377	REPLACE_SV (PL_rs, c->irssv);
378	if (!c->irssv_sv) c->irssv_sv = get_sv ("/", 0);
379	sv_setsv (c->irssv_sv, PL_rs);
380	}
381	}
382		396
383	{	397	{
384	dSP;	398	dSP;
385	CV *cv;	399	CV *cv;
386		400
…		…
444	}	458	}
445		459
446	PUTBACK;	460	PUTBACK;
447	}	461	}
448		462
449	c->defav = c->save & CORO_SAVE_DEFAV ? (AV *)SvREFCNT_inc (GvAV (PL_defgv)) : 0;	463	c->defav = GvAV (PL_defgv);
450	c->defsv = c->save & CORO_SAVE_DEFSV ? SvREFCNT_inc (DEFSV) : 0;	464	c->defsv = DEFSV;
451	c->errsv = c->save & CORO_SAVE_ERRSV ? SvREFCNT_inc (ERRSV) : 0;	465	c->errsv = ERRSV;
452	c->deffh = c->save & CORO_SAVE_DEFFH ? (GV *)SvREFCNT_inc (PL_defoutgv) : 0;	466	c->irssv_sv = GvSV (irsgv);
453	c->irssv = c->save & CORO_SAVE_IRSSV ? SvREFCNT_inc (PL_rs) : 0;
454		467
455	#define VAR(name,type)c->name = PL_ ## name;	468	#define VAR(name,type)c->name = PL_ ## name;
456	# include "state.h"	469	# include "state.h"
457	#undef VAR	470	#undef VAR
458	}	471	}
…		…
511	* destroy the stacks, the callchain etc...	524	* destroy the stacks, the callchain etc...
512	*/	525	*/
513	static void	526	static void
514	coro_destroy_stacks (pTHX)	527	coro_destroy_stacks (pTHX)
515	{	528	{
516	if (!IN_DESTRUCT)
517	{
518	/* restore all saved variables and stuff */
519	LEAVE_SCOPE (0);
520	assert (PL_tmps_floor == -1);
521
522	/* free all temporaries */
523	FREETMPS;
524	assert (PL_tmps_ix == -1);
525
526	/* unwind all extra stacks */
527	POPSTACK_TO (PL_mainstack);
528
529	/* unwind main stack */
530	dounwind (-1);
531	}
532
533	while (PL_curstackinfo->si_next)	529	while (PL_curstackinfo->si_next)
534	PL_curstackinfo = PL_curstackinfo->si_next;	530	PL_curstackinfo = PL_curstackinfo->si_next;
535		531
536	while (PL_curstackinfo)	532	while (PL_curstackinfo)
537	{	533	{
…		…
553	Safefree (PL_retstack);	549	Safefree (PL_retstack);
554	#endif	550	#endif
555	}	551	}
556		552
557	static size_t	553	static size_t
558	coro_rss (struct coro *coro)	554	coro_rss (pTHX_ struct coro *coro)
559	{	555	{
560	size_t rss = sizeof (coro);	556	size_t rss = sizeof (*coro);
561		557
562	if (coro->mainstack)	558	if (coro->mainstack)
563	{	559	{
564	if (coro->flags & CF_RUNNING)	560	if (coro->flags & CF_RUNNING)
565	{	561	{
…		…
586	}	582	}
587		583
588	/ coroutine stack handling **********************************************/	584	/ coroutine stack handling **********************************************/
589		585
590	static void	586	static void
591	setup_coro (pTHX_ struct coro *coro)	587	coro_setup (pTHX_ struct coro *coro)
592	{	588	{
593	/*	589	/*
594	* emulate part of the perl startup here.	590	* emulate part of the perl startup here.
595	*/	591	*/
596	coro_init_stacks (aTHX);	592	coro_init_stacks (aTHX);
597		593
		594	PL_runops = RUNOPS_DEFAULT;
598	PL_curcop = &PL_compiling;	595	PL_curcop = &PL_compiling;
599	PL_in_eval = EVAL_NULL;	596	PL_in_eval = EVAL_NULL;
600	PL_comppad = 0;	597	PL_comppad = 0;
601	PL_curpm = 0;	598	PL_curpm = 0;
602	PL_localizing = 0;	599	PL_localizing = 0;
603	PL_dirty = 0;	600	PL_dirty = 0;
604	PL_restartop = 0;	601	PL_restartop = 0;
		602
		603	GvSV (PL_defgv) = NEWSV (0, 0);
		604	GvAV (PL_defgv) = coro->args; coro->args = 0;
		605	GvSV (PL_errgv) = NEWSV (0, 0);
		606	GvSV (irsgv) = newSVpvn ("\n", 1); sv_magic (GvSV (irsgv), (SV *)irsgv, PERL_MAGIC_sv, "/", 0);
		607	PL_rs = newSVsv (GvSV (irsgv));
		608
		609	{
		610	IO *io = newIO ();
		611	PL_defoutgv = newGVgen ("Coro");
		612	GvIOp(PL_defoutgv) = io;
		613	IoTYPE (io) = IoTYPE_WRONLY;
		614	IoOFP (io) = IoIFP (io) = PerlIO_stdout ();
		615	IoFLAGS (io) \|= IOf_FLUSH;
		616	}
605		617
606	{	618	{
607	dSP;	619	dSP;
608	LOGOP myop;	620	LOGOP myop;
609
610	SvREFCNT_dec (GvAV (PL_defgv));
611	GvAV (PL_defgv) = coro->args; coro->args = 0;
612		621
613	Zero (&myop, 1, LOGOP);	622	Zero (&myop, 1, LOGOP);
614	myop.op_next = Nullop;	623	myop.op_next = Nullop;
615	myop.op_flags = OPf_WANT_VOID;	624	myop.op_flags = OPf_WANT_VOID;
616		625
…		…
624		633
625	ENTER; /* necessary e.g. for dounwind */	634	ENTER; /* necessary e.g. for dounwind */
626	}	635	}
627		636
628	static void	637	static void
		638	coro_destroy (pTHX_ struct coro *coro)
		639	{
		640	if (!IN_DESTRUCT)
		641	{
		642	/* restore all saved variables and stuff */
		643	LEAVE_SCOPE (0);
		644	assert (PL_tmps_floor == -1);
		645
		646	/* free all temporaries */
		647	FREETMPS;
		648	assert (PL_tmps_ix == -1);
		649
		650	/* unwind all extra stacks */
		651	POPSTACK_TO (PL_mainstack);
		652
		653	/* unwind main stack */
		654	dounwind (-1);
		655	}
		656
		657	SvREFCNT_dec (GvSV (PL_defgv));
		658	SvREFCNT_dec (GvAV (PL_defgv));
		659	SvREFCNT_dec (GvSV (PL_errgv));
		660	SvREFCNT_dec (PL_defoutgv);
		661	SvREFCNT_dec (PL_rs);
		662	SvREFCNT_dec (GvSV (irsgv));
		663
		664	SvREFCNT_dec (coro->saved_deffh);
		665	//SvREFCNT_dec (coro->throw);
		666
		667	coro_destroy_stacks (aTHX);
		668	}
		669
		670	static void
629	free_coro_mortal (pTHX)	671	free_coro_mortal (pTHX)
630	{	672	{
631	if (coro_mortal)	673	if (coro_mortal)
632	{	674	{
633	SvREFCNT_dec (coro_mortal);	675	SvREFCNT_dec (coro_mortal);
634	coro_mortal = 0;	676	coro_mortal = 0;
635	}	677	}
636	}	678	}
637		679
638	static int	680	static int
639	runops_coro (pTHX)	681	runops_trace (pTHX)
640	{	682	{
641	COP *oldcop = 0;	683	COP *oldcop = 0;
642	int oldcxix = -2;	684	int oldcxix = -2;
		685	struct coro coro = SvSTATE (coro_current); / trace cctx is tied to specific coro */
		686	coro_cctx *cctx = coro->cctx;
643		687
644	while ((PL_op = CALL_FPTR (PL_op->op_ppaddr) (aTHX)))	688	while ((PL_op = CALL_FPTR (PL_op->op_ppaddr) (aTHX)))
645	{	689	{
646	PERL_ASYNC_CHECK ();	690	PERL_ASYNC_CHECK ();
647		691
648	if (PL_op->op_type == OP_LEAVESUB)	692	if (cctx->flags & CC_TRACE_ALL)
649	{	693	{
650	PERL_CONTEXT *cx = &cxstack[cxstack_ix];	694	if (PL_op->op_type == OP_LEAVESUB && cctx->flags & CC_TRACE_SUB)
651	SV bot, top;
652	AV av = newAV (); / return values */
653	runops_proc_t old_runops = PL_runops;
654	dSP;
655	ENTER;
656	SAVETMPS;
657	EXTEND (SP, 3);
658	PL_runops = RUNOPS_DEFAULT;
659
660	GV *gv = CvGV (cx->blk_sub.cv);
661	SV *fullname = sv_2mortal (newSV (0));
662	if (isGV (gv))
663	gv_efullname3 (fullname, gv, 0);
664
665	bot = PL_stack_base + cx->blk_oldsp + 1;
666	top = cx->blk_gimme == G_ARRAY ? SP + 1
667	: cx->blk_gimme == G_SCALAR ? bot + 1
668	: bot;
669
670	while (bot < top)
671	av_push (av, SvREFCNT_inc (*bot++));
672
673	PUSHMARK (SP);
674	PUSHs (&PL_sv_no);
675	PUSHs (fullname);
676	PUSHs (sv_2mortal (newRV_noinc ((SV *)av)));
677	PUTBACK;
678	call_pv ("Coro::_do_trace_sub", G_KEEPERR \| G_EVAL \| G_VOID \| G_DISCARD);
679	SPAGAIN;
680
681	FREETMPS;
682	LEAVE;
683	PL_runops = old_runops;
684	}
685
686	if (oldcop != PL_curcop)
687	{
688	oldcop = PL_curcop;
689
690	if (PL_curcop != &PL_compiling)
691	{	695	{
692	runops_proc_t old_runops = PL_runops;	696	PERL_CONTEXT *cx = &cxstack[cxstack_ix];
		697	SV bot, top;
		698	AV av = newAV (); / return values */
		699	SV **cb;
693	dSP;	700	dSP;
		701
		702	GV *gv = CvGV (cx->blk_sub.cv);
		703	SV *fullname = sv_2mortal (newSV (0));
		704	if (isGV (gv))
		705	gv_efullname3 (fullname, gv, 0);
		706
		707	bot = PL_stack_base + cx->blk_oldsp + 1;
		708	top = cx->blk_gimme == G_ARRAY ? SP + 1
		709	: cx->blk_gimme == G_SCALAR ? bot + 1
		710	: bot;
		711
		712	while (bot < top)
		713	av_push (av, SvREFCNT_inc (*bot++));
		714
		715	PL_runops = RUNOPS_DEFAULT;
694	ENTER;	716	ENTER;
695	SAVETMPS;	717	SAVETMPS;
696	EXTEND (SP, 3);	718	EXTEND (SP, 3);
697	PL_runops = RUNOPS_DEFAULT;
698
699	if (oldcxix != cxstack_ix)
700	{
701	PERL_CONTEXT *cx = &cxstack[cxstack_ix];
702
703	if (CxTYPE (cx) == CXt_SUB && oldcxix < cxstack_ix)
704	{
705	GV *gv = CvGV (cx->blk_sub.cv);
706	SV *fullname = sv_2mortal (newSV (0));
707	if (isGV (gv))
708	gv_efullname3 (fullname, gv, 0);
709
710	PUSHMARK (SP);
711	PUSHs (&PL_sv_yes);
712	PUSHs (fullname);
713	PUSHs (cx->blk_sub.hasargs ? sv_2mortal (newRV_inc ((SV *)cx->blk_sub.argarray)) : &PL_sv_undef);
714	PUTBACK;
715	call_pv ("Coro::_do_trace_sub", G_KEEPERR \| G_EVAL \| G_VOID \| G_DISCARD);
716	SPAGAIN;
717	}
718
719	oldcxix = cxstack_ix;
720	}
721
722	if (0) {
723	PUSHMARK (SP);	719	PUSHMARK (SP);
724	PUSHs (sv_2mortal (newSVpv (OutCopFILE (oldcop), 0)));	720	PUSHs (&PL_sv_no);
725	PUSHs (sv_2mortal (newSViv (CopLINE (oldcop))));	721	PUSHs (fullname);
		722	PUSHs (sv_2mortal (newRV_noinc ((SV *)av)));
726	PUTBACK;	723	PUTBACK;
		724	cb = hv_fetch ((HV *)SvRV (coro_current), "_trace_sub_cb", sizeof ("_trace_sub_cb") - 1, 0);
727	call_pv ("Coro::_do_trace_line", G_KEEPERR \| G_EVAL \| G_VOID \| G_DISCARD);	725	if (cb) call_sv (*cb, G_KEEPERR \| G_EVAL \| G_VOID \| G_DISCARD);
728	SPAGAIN;	726	SPAGAIN;
729	}
730
731	FREETMPS;	727	FREETMPS;
732	LEAVE;	728	LEAVE;
733	PL_runops = old_runops;	729	PL_runops = runops_trace;
		730	}
		731
		732	if (oldcop != PL_curcop)
		733	{
		734	oldcop = PL_curcop;
		735
		736	if (PL_curcop != &PL_compiling)
		737	{
		738	SV **cb;
		739
		740	if (oldcxix != cxstack_ix && cctx->flags & CC_TRACE_SUB)
		741	{
		742	PERL_CONTEXT *cx = &cxstack[cxstack_ix];
		743
		744	if (CxTYPE (cx) == CXt_SUB && oldcxix < cxstack_ix)
		745	{
		746	runops_proc_t old_runops = PL_runops;
		747	dSP;
		748	GV *gv = CvGV (cx->blk_sub.cv);
		749	SV *fullname = sv_2mortal (newSV (0));
		750
		751	if (isGV (gv))
		752	gv_efullname3 (fullname, gv, 0);
		753
		754	PL_runops = RUNOPS_DEFAULT;
		755	ENTER;
		756	SAVETMPS;
		757	EXTEND (SP, 3);
		758	PUSHMARK (SP);
		759	PUSHs (&PL_sv_yes);
		760	PUSHs (fullname);
		761	PUSHs (cx->blk_sub.hasargs ? sv_2mortal (newRV_inc ((SV *)cx->blk_sub.argarray)) : &PL_sv_undef);
		762	PUTBACK;
		763	cb = hv_fetch ((HV *)SvRV (coro_current), "_trace_sub_cb", sizeof ("_trace_sub_cb") - 1, 0);
		764	if (cb) call_sv (*cb, G_KEEPERR \| G_EVAL \| G_VOID \| G_DISCARD);
		765	SPAGAIN;
		766	FREETMPS;
		767	LEAVE;
		768	PL_runops = runops_trace;
		769	}
		770
		771	oldcxix = cxstack_ix;
		772	}
		773
		774	if (cctx->flags & CC_TRACE_LINE)
		775	{
		776	dSP;
		777
		778	PL_runops = RUNOPS_DEFAULT;
		779	ENTER;
		780	SAVETMPS;
		781	EXTEND (SP, 3);
		782	PL_runops = RUNOPS_DEFAULT;
		783	PUSHMARK (SP);
		784	PUSHs (sv_2mortal (newSVpv (OutCopFILE (oldcop), 0)));
		785	PUSHs (sv_2mortal (newSViv (CopLINE (oldcop))));
		786	PUTBACK;
		787	cb = hv_fetch ((HV *)SvRV (coro_current), "_trace_line_cb", sizeof ("_trace_line_cb") - 1, 0);
		788	if (cb) call_sv (*cb, G_KEEPERR \| G_EVAL \| G_VOID \| G_DISCARD);
		789	SPAGAIN;
		790	FREETMPS;
		791	LEAVE;
		792	PL_runops = runops_trace;
		793	}
		794	}
734	}	795	}
735	}	796	}
736	}	797	}
737		798
738	TAINT_NOT;	799	TAINT_NOT;
…		…
749	LOGOP myop;	810	LOGOP myop;
750		811
751	PL_top_env = &PL_start_env;	812	PL_top_env = &PL_start_env;
752		813
753	if (cctx->flags & CC_TRACE)	814	if (cctx->flags & CC_TRACE)
754	PL_runops = runops_coro;	815	PL_runops = runops_trace;
755		816
756	Zero (&myop, 1, LOGOP);	817	Zero (&myop, 1, LOGOP);
757	myop.op_next = PL_op;	818	myop.op_next = PL_op;
758	myop.op_flags = OPf_WANT_VOID \| OPf_STACKED;	819	myop.op_flags = OPf_WANT_VOID \| OPf_STACKED;
759		820
…		…
905	cctx_first = cctx;	966	cctx_first = cctx;
906	}	967	}
907		968
908	/ coroutine switching ***************************************************/	969	/ coroutine switching ***************************************************/
909		970
910	/* never call directly, always through the coro_state_transfer global variable */	971	static void NOINLINE
		972	transfer_check (pTHX_ struct coro prev, struct coro next)
		973	{
		974	if (prev != next)
		975	{
		976	if (!(prev->flags & (CF_RUNNING \| CF_NEW)))
		977	croak ("Coro::State::transfer called with non-running/new prev Coro::State, but can only transfer from running or new states");
		978
		979	if (next->flags & CF_RUNNING)
		980	croak ("Coro::State::transfer called with running next Coro::State, but can only transfer to inactive states");
		981
		982	if (next->flags & CF_DESTROYED)
		983	croak ("Coro::State::transfer called with destroyed next Coro::State, but can only transfer to inactive states");
		984
		985	if (PL_lex_state != LEX_NOTPARSING)
		986	croak ("Coro::State::transfer called while parsing, but this is not supported");
		987	}
		988	}
		989
		990	/* always use the TRANSFER macro */
911	static void NOINLINE	991	static void NOINLINE
912	transfer (pTHX_ struct coro prev, struct coro next)	992	transfer (pTHX_ struct coro prev, struct coro next)
913	{	993	{
914	dSTACKLEVEL;	994	dSTACKLEVEL;
915		995
…		…
929	Newz (0, prev->cctx, 1, coro_cctx);	1009	Newz (0, prev->cctx, 1, coro_cctx);
930	prev->flags &= ~CF_NEW;	1010	prev->flags &= ~CF_NEW;
931	prev->flags \|= CF_RUNNING;	1011	prev->flags \|= CF_RUNNING;
932	}	1012	}
933		1013
934	/TODO: must not croak here /
935	if (!prev->flags & CF_RUNNING)
936	croak ("Coro::State::transfer called with non-running prev Coro::State, but can only transfer from running states");
937
938	if (next->flags & CF_RUNNING)
939	croak ("Coro::State::transfer called with running next Coro::State, but can only transfer to inactive states");
940
941	if (next->flags & CF_DESTROYED)
942	croak ("Coro::State::transfer called with destroyed next Coro::State, but can only transfer to inactive states");
943
944	prev->flags &= ~CF_RUNNING;	1014	prev->flags &= ~CF_RUNNING;
945	next->flags \|= CF_RUNNING;	1015	next->flags \|= CF_RUNNING;
946		1016
947	LOCK;	1017	LOCK;
948		1018
…		…
951	/* need to start coroutine */	1021	/* need to start coroutine */
952	next->flags &= ~CF_NEW;	1022	next->flags &= ~CF_NEW;
953	/* first get rid of the old state */	1023	/* first get rid of the old state */
954	save_perl (aTHX_ prev);	1024	save_perl (aTHX_ prev);
955	/* setup coroutine call */	1025	/* setup coroutine call */
956	setup_coro (aTHX_ next);	1026	coro_setup (aTHX_ next);
957	}	1027	}
958	else	1028	else
959	{	1029	{
960	/* coroutine already started */	1030	/* coroutine already started */
961	save_perl (aTHX_ prev);	1031	save_perl (aTHX_ prev);
…		…
973	prev->cctx = 0;	1043	prev->cctx = 0;
974		1044
975	cctx_put (prev__cctx);	1045	cctx_put (prev__cctx);
976	}	1046	}
977		1047
		1048	++next->usecount;
		1049
978	if (!next->cctx)	1050	if (!next->cctx)
979	next->cctx = cctx_get (aTHX);	1051	next->cctx = cctx_get (aTHX);
980		1052
981	if (prev__cctx != next->cctx)	1053	if (prev__cctx != next->cctx)
982	{	1054	{
…		…
994	{	1066	{
995	struct coro prev, next;	1067	struct coro prev, next;
996	};	1068	};
997		1069
998	#define TRANSFER(ta) transfer (aTHX_ (ta).prev, (ta).next)	1070	#define TRANSFER(ta) transfer (aTHX_ (ta).prev, (ta).next)
		1071	#define TRANSFER_CHECK(ta) transfer_check (aTHX_ (ta).prev, (ta).next)
999		1072
1000	/ high level stuff ******************************************************/	1073	/ high level stuff ******************************************************/
1001		1074
1002	static int	1075	static int
1003	coro_state_destroy (pTHX_ struct coro *coro)	1076	coro_state_destroy (pTHX_ struct coro *coro)
…		…
1020		1093
1021	if (coro->mainstack && coro->mainstack != main_mainstack)	1094	if (coro->mainstack && coro->mainstack != main_mainstack)
1022	{	1095	{
1023	struct coro temp;	1096	struct coro temp;
1024		1097
1025	assert (!(coro->flags & CF_RUNNING));
1026
1027	Zero (&temp, 1, struct coro);
1028	temp.save = CORO_SAVE_ALL;
1029
1030	if (coro->flags & CF_RUNNING)	1098	if (coro->flags & CF_RUNNING)
1031	croak ("FATAL: tried to destroy currently running coroutine");	1099	croak ("FATAL: tried to destroy currently running coroutine");
1032		1100
1033	save_perl (aTHX_ &temp);	1101	save_perl (aTHX_ &temp);
1034	load_perl (aTHX_ coro);	1102	load_perl (aTHX_ coro);
1035		1103
1036	coro_destroy_stacks (aTHX);	1104	coro_destroy (aTHX_ coro);
1037		1105
1038	load_perl (aTHX_ &temp); /* this will get rid of defsv etc.. */	1106	load_perl (aTHX_ &temp); /* this will get rid of defsv etc.. */
1039		1107
1040	coro->mainstack = 0;	1108	coro->mainstack = 0;
1041	}	1109	}
…		…
1086	#else	1154	#else
1087	# define MGf_DUP 0	1155	# define MGf_DUP 0
1088	#endif	1156	#endif
1089	};	1157	};
1090		1158
1091	static struct coro *
1092	SvSTATE_ (pTHX_ SV *coro)
1093	{
1094	HV *stash;
1095	MAGIC *mg;
1096
1097	if (SvROK (coro))
1098	coro = SvRV (coro);
1099
1100	stash = SvSTASH (coro);
1101	if (stash != coro_stash && stash != coro_state_stash)
1102	{
1103	/* very slow, but rare, check */
1104	if (!sv_derived_from (sv_2mortal (newRV_inc (coro)), "Coro::State"))
1105	croak ("Coro::State object required");
1106	}
1107
1108	mg = CORO_MAGIC (coro);
1109	return (struct coro *)mg->mg_ptr;
1110	}
1111
1112	#define SvSTATE(sv) SvSTATE_ (aTHX_ (sv))
1113
1114	static void	1159	static void
1115	prepare_transfer (pTHX_ struct transfer_args ta, SV prev_sv, SV *next_sv)	1160	prepare_transfer (pTHX_ struct transfer_args ta, SV prev_sv, SV *next_sv)
1116	{	1161	{
1117	ta->prev = SvSTATE (prev_sv);	1162	ta->prev = SvSTATE (prev_sv);
1118	ta->next = SvSTATE (next_sv);	1163	ta->next = SvSTATE (next_sv);
		1164	TRANSFER_CHECK (*ta);
1119	}	1165	}
1120		1166
1121	static void	1167	static void
1122	api_transfer (SV prev_sv, SV next_sv)	1168	api_transfer (SV prev_sv, SV next_sv)
1123	{	1169	{
1124	dTHX;	1170	dTHX;
1125	struct transfer_args ta;	1171	struct transfer_args ta;
1126		1172
1127	prepare_transfer (aTHX_ &ta, prev_sv, next_sv);	1173	prepare_transfer (aTHX_ &ta, prev_sv, next_sv);
1128	TRANSFER (ta);	1174	TRANSFER (ta);
1129	}
1130
1131	static int
1132	api_save (SV *coro_sv, int new_save)
1133	{
1134	dTHX;
1135	struct coro *coro = SvSTATE (coro_sv);
1136	int old_save = coro->save;
1137
1138	if (new_save >= 0)
1139	coro->save = new_save;
1140
1141	return old_save;
1142	}	1175	}
1143		1176
1144	/ Coro ******************************************************************/	1177	/ Coro ******************************************************************/
1145		1178
1146	static void	1179	static void
…		…
1240	break;	1273	break;
1241	}	1274	}
1242		1275
1243	/* free this only after the transfer */	1276	/* free this only after the transfer */
1244	prev_sv = SvRV (coro_current);	1277	prev_sv = SvRV (coro_current);
1245	SvRV_set (coro_current, next_sv);
1246	ta->prev = SvSTATE (prev_sv);	1278	ta->prev = SvSTATE (prev_sv);
1247		1279	TRANSFER_CHECK (*ta);
1248	assert (ta->next->flags & CF_READY);	1280	assert (ta->next->flags & CF_READY);
1249	ta->next->flags &= ~CF_READY;	1281	ta->next->flags &= ~CF_READY;
		1282	SvRV_set (coro_current, next_sv);
1250		1283
1251	LOCK;	1284	LOCK;
1252	free_coro_mortal (aTHX);	1285	free_coro_mortal (aTHX);
1253	coro_mortal = prev_sv;	1286	coro_mortal = prev_sv;
1254	UNLOCK;	1287	UNLOCK;
…		…
1315	}	1348	}
1316	else	1349	else
1317	return 0;	1350	return 0;
1318	}	1351	}
1319		1352
		1353	static void
		1354	api_trace (SV *coro_sv, int flags)
		1355	{
		1356	dTHX;
		1357	struct coro *coro = SvSTATE (coro_sv);
		1358
		1359	if (flags & CC_TRACE)
		1360	{
		1361	if (!coro->cctx)
		1362	coro->cctx = cctx_new ();
		1363	else if (!(coro->cctx->flags & CC_TRACE))
		1364	croak ("cannot enable tracing on coroutine with custom stack");
		1365
		1366	coro->cctx->flags \|= CC_NOREUSE \| (flags & (CC_TRACE \| CC_TRACE_ALL));
		1367	}
		1368	else if (coro->cctx && coro->cctx->flags & CC_TRACE)
		1369	{
		1370	coro->cctx->flags &= ~(CC_TRACE \| CC_TRACE_ALL);
		1371
		1372	if (coro->flags & CF_RUNNING)
		1373	PL_runops = RUNOPS_DEFAULT;
		1374	else
		1375	coro->runops = RUNOPS_DEFAULT;
		1376	}
		1377	}
		1378
1320	MODULE = Coro::State PACKAGE = Coro::State	1379	MODULE = Coro::State PACKAGE = Coro::State PREFIX = api_
1321		1380
1322	PROTOTYPES: DISABLE	1381	PROTOTYPES: DISABLE
1323		1382
1324	BOOT:	1383	BOOT:
1325	{	1384	{
1326	#ifdef USE_ITHREADS	1385	#ifdef USE_ITHREADS
1327	MUTEX_INIT (&coro_mutex);	1386	MUTEX_INIT (&coro_mutex);
1328	#endif	1387	#endif
1329	BOOT_PAGESIZE;	1388	BOOT_PAGESIZE;
		1389
		1390	irsgv = gv_fetchpv ("/", 1, SVt_PV);
1330		1391
1331	coro_state_stash = gv_stashpv ("Coro::State", TRUE);	1392	coro_state_stash = gv_stashpv ("Coro::State", TRUE);
1332		1393
1333	newCONSTSUB (coro_state_stash, "CC_TRACE" , newSViv (CC_TRACE));	1394	newCONSTSUB (coro_state_stash, "CC_TRACE" , newSViv (CC_TRACE));
1334	newCONSTSUB (coro_state_stash, "CC_TRACE_SUB" , newSViv (CC_TRACE_SUB));	1395	newCONSTSUB (coro_state_stash, "CC_TRACE_SUB" , newSViv (CC_TRACE_SUB));
1335	newCONSTSUB (coro_state_stash, "CC_TRACE_LINE", newSViv (CC_TRACE_LINE));	1396	newCONSTSUB (coro_state_stash, "CC_TRACE_LINE", newSViv (CC_TRACE_LINE));
1336	newCONSTSUB (coro_state_stash, "CC_TRACE_ALL" , newSViv (CC_TRACE_ALL));	1397	newCONSTSUB (coro_state_stash, "CC_TRACE_ALL" , newSViv (CC_TRACE_ALL));
1337		1398
1338	newCONSTSUB (coro_state_stash, "SAVE_DEFAV", newSViv (CORO_SAVE_DEFAV));
1339	newCONSTSUB (coro_state_stash, "SAVE_DEFSV", newSViv (CORO_SAVE_DEFSV));
1340	newCONSTSUB (coro_state_stash, "SAVE_ERRSV", newSViv (CORO_SAVE_ERRSV));
1341	newCONSTSUB (coro_state_stash, "SAVE_IRSSV", newSViv (CORO_SAVE_IRSSV));
1342	newCONSTSUB (coro_state_stash, "SAVE_DEFFH", newSViv (CORO_SAVE_DEFFH));
1343	newCONSTSUB (coro_state_stash, "SAVE_DEF", newSViv (CORO_SAVE_DEF));
1344	newCONSTSUB (coro_state_stash, "SAVE_ALL", newSViv (CORO_SAVE_ALL));
1345
1346	main_mainstack = PL_mainstack;	1399	main_mainstack = PL_mainstack;
1347	main_top_env = PL_top_env;	1400	main_top_env = PL_top_env;
1348		1401
1349	while (main_top_env->je_prev)	1402	while (main_top_env->je_prev)
1350	main_top_env = main_top_env->je_prev;	1403	main_top_env = main_top_env->je_prev;
…		…
1362	struct coro *coro;	1415	struct coro *coro;
1363	HV *hv;	1416	HV *hv;
1364	int i;	1417	int i;
1365		1418
1366	Newz (0, coro, 1, struct coro);	1419	Newz (0, coro, 1, struct coro);
1367	coro->args = newAV ();	1420	coro->args = newAV ();
1368	coro->save = CORO_SAVE_DEF;
1369	coro->flags = CF_NEW;	1421	coro->flags = CF_NEW;
1370		1422
1371	if (coro_first) coro_first->prev = coro;	1423	if (coro_first) coro_first->prev = coro;
1372	coro->next = coro_first;	1424	coro->next = coro_first;
1373	coro_first = coro;	1425	coro_first = coro;
…		…
1380	av_push (coro->args, newSVsv (ST (i)));	1432	av_push (coro->args, newSVsv (ST (i)));
1381	}	1433	}
1382	OUTPUT:	1434	OUTPUT:
1383	RETVAL	1435	RETVAL
1384		1436
1385	int	1437	# these not obviously related functions are all rolled into the same xs
1386	save (SV *coro, int new_save = -1)	1438	# function to increase chances that they all will call transfer with the same
1387	CODE:	1439	# stack offset
1388	RETVAL = api_save (coro, new_save);
1389	OUTPUT:
1390	RETVAL
1391
1392	int
1393	save_also (SV *coro_sv, int save_also)
1394	CODE:
1395	{
1396	struct coro *coro = SvSTATE (coro_sv);
1397	RETVAL = coro->save;
1398	coro->save \|= save_also;
1399	}
1400	OUTPUT:
1401	RETVAL
1402
1403	void	1440	void
1404	_set_stacklevel (...)	1441	_set_stacklevel (...)
1405	ALIAS:	1442	ALIAS:
1406	Coro::State::transfer = 1	1443	Coro::State::transfer = 1
1407	Coro::schedule = 2	1444	Coro::schedule = 2
…		…
1502	{	1539	{
1503	if (coro->mainstack)	1540	if (coro->mainstack)
1504	{	1541	{
1505	struct coro temp;	1542	struct coro temp;
1506	Zero (&temp, 1, struct coro);	1543	Zero (&temp, 1, struct coro);
1507	temp.save = CORO_SAVE_ALL;
1508		1544
1509	if (!(coro->flags & CF_RUNNING))	1545	if (!(coro->flags & CF_RUNNING))
1510	{	1546	{
1511	save_perl (aTHX_ &temp);	1547	save_perl (aTHX_ &temp);
1512	load_perl (aTHX_ coro);	1548	load_perl (aTHX_ coro);
…		…
1533	save_perl (aTHX_ coro);	1569	save_perl (aTHX_ coro);
1534	load_perl (aTHX_ &temp);	1570	load_perl (aTHX_ &temp);
1535	}	1571	}
1536	}	1572	}
1537	}	1573	}
1538		1574
1539	SV *	1575	SV *
1540	is_ready (Coro::State coro)	1576	is_ready (Coro::State coro)
1541	PROTOTYPE: $	1577	PROTOTYPE: $
1542	ALIAS:	1578	ALIAS:
1543	is_ready = CF_READY	1579	is_ready = CF_READY
…		…
1548	RETVAL = boolSV (coro->flags & ix);	1584	RETVAL = boolSV (coro->flags & ix);
1549	OUTPUT:	1585	OUTPUT:
1550	RETVAL	1586	RETVAL
1551		1587
1552	void	1588	void
1553	trace (Coro::State coro, int flags = CC_TRACE \| CC_TRACE_SUB)	1589	api_trace (SV *coro, int flags = CC_TRACE \| CC_TRACE_SUB)
1554	CODE:
1555	if (flags & CC_TRACE)
1556	{
1557	if (!coro->cctx)
1558	coro->cctx = cctx_new ();
1559	else if (!(coro->cctx->flags & CC_TRACE))
1560	croak ("cannot enable tracing on coroutine with custom stack");
1561
1562	coro->cctx->flags \|= flags & (CC_TRACE \| CC_TRACE_ALL);
1563	}
1564	else
1565	if (coro->cctx && coro->cctx->flags & CC_TRACE)
1566	{
1567	coro->cctx->flags &= ~(CC_TRACE \| CC_TRACE_ALL);
1568	coro->cctx->flags \|= CC_NOREUSE;
1569
1570	if (coro->flags & CF_RUNNING)
1571	PL_runops = RUNOPS_DEFAULT;
1572	else
1573	coro->runops = RUNOPS_DEFAULT;
1574	}
1575		1590
1576	SV *	1591	SV *
1577	has_stack (Coro::State coro)	1592	has_stack (Coro::State coro)
1578	PROTOTYPE: $	1593	PROTOTYPE: $
1579	CODE:	1594	CODE:
…		…
1590	RETVAL	1605	RETVAL
1591		1606
1592	IV	1607	IV
1593	rss (Coro::State coro)	1608	rss (Coro::State coro)
1594	PROTOTYPE: $	1609	PROTOTYPE: $
		1610	ALIAS:
		1611	usecount = 1
1595	CODE:	1612	CODE:
1596	RETVAL = coro_rss (coro);	1613	switch (ix)
		1614	{
		1615	case 0: RETVAL = coro_rss (aTHX_ coro); break;
		1616	case 1: RETVAL = coro->usecount; break;
		1617	}
1597	OUTPUT:	1618	OUTPUT:
1598	RETVAL	1619	RETVAL
1599		1620
1600		1621
1601	MODULE = Coro::State PACKAGE = Coro	1622	MODULE = Coro::State PACKAGE = Coro
…		…
1606		1627
1607	sv_pool_rss = get_sv ("Coro::POOL_RSS" , TRUE);	1628	sv_pool_rss = get_sv ("Coro::POOL_RSS" , TRUE);
1608	sv_pool_size = get_sv ("Coro::POOL_SIZE" , TRUE);	1629	sv_pool_size = get_sv ("Coro::POOL_SIZE" , TRUE);
1609	av_async_pool = get_av ("Coro::async_pool", TRUE);	1630	av_async_pool = get_av ("Coro::async_pool", TRUE);
1610		1631
1611	coro_current = get_sv ("Coro::current", FALSE);	1632	coro_current = get_sv ("Coro::current", FALSE);
1612	SvREADONLY_on (coro_current);	1633	SvREADONLY_on (coro_current);
1613		1634
1614	coro_stash = gv_stashpv ("Coro", TRUE);	1635	coro_stash = gv_stashpv ("Coro", TRUE);
1615		1636
1616	newCONSTSUB (coro_stash, "PRIO_MAX", newSViv (PRIO_MAX));	1637	newCONSTSUB (coro_stash, "PRIO_MAX", newSViv (PRIO_MAX));
…		…
1625		1646
1626	{	1647	{
1627	SV *sv = perl_get_sv("Coro::API", 1);	1648	SV *sv = perl_get_sv("Coro::API", 1);
1628		1649
1629	coroapi.schedule = api_schedule;	1650	coroapi.schedule = api_schedule;
1630	coroapi.save = api_save;
1631	coroapi.cede = api_cede;	1651	coroapi.cede = api_cede;
1632	coroapi.cede_notself = api_cede_notself;	1652	coroapi.cede_notself = api_cede_notself;
1633	coroapi.ready = api_ready;	1653	coroapi.ready = api_ready;
1634	coroapi.is_ready = api_is_ready;	1654	coroapi.is_ready = api_is_ready;
1635	coroapi.nready = &coro_nready;	1655	coroapi.nready = &coro_nready;
…		…
1689	# for async_pool speedup	1709	# for async_pool speedup
1690	void	1710	void
1691	_pool_1 (SV *cb)	1711	_pool_1 (SV *cb)
1692	CODE:	1712	CODE:
1693	{	1713	{
1694	int i, len;	1714	struct coro *coro = SvSTATE (coro_current);
1695	HV hv = (HV )SvRV (coro_current);	1715	HV hv = (HV )SvRV (coro_current);
1696	AV *defav = GvAV (PL_defgv);	1716	AV *defav = GvAV (PL_defgv);
1697	SV *invoke = hv_delete (hv, "_invoke", sizeof ("_invoke") - 1, 0);	1717	SV *invoke = hv_delete (hv, "_invoke", sizeof ("_invoke") - 1, 0);
1698	AV *invoke_av;	1718	AV *invoke_av;
		1719	int i, len;
1699		1720
1700	if (!invoke)	1721	if (!invoke)
1701	croak ("\3terminate\2\n");	1722	croak ("\3terminate\2\n");
		1723
		1724	SvREFCNT_dec (coro->saved_deffh);
		1725	coro->saved_deffh = SvREFCNT_inc ((SV *)PL_defoutgv);
1702		1726
1703	hv_store (hv, "desc", sizeof ("desc") - 1,	1727	hv_store (hv, "desc", sizeof ("desc") - 1,
1704	newSVpvn ("[async_pool]", sizeof ("[async_pool]") - 1), 0);	1728	newSVpvn ("[async_pool]", sizeof ("[async_pool]") - 1), 0);
1705		1729
1706	invoke_av = (AV *)SvRV (invoke);	1730	invoke_av = (AV *)SvRV (invoke);
…		…
1724	{	1748	{
1725	struct coro *coro = SvSTATE (coro_current);	1749	struct coro *coro = SvSTATE (coro_current);
1726		1750
1727	sv_setsv (cb, &PL_sv_undef);	1751	sv_setsv (cb, &PL_sv_undef);
1728		1752
		1753	SvREFCNT_dec ((SV )PL_defoutgv); PL_defoutgv = (GV )coro->saved_deffh;
		1754	coro->saved_deffh = 0;
		1755
1729	if (coro_rss (coro) > SvIV (sv_pool_rss)	1756	if (coro_rss (aTHX_ coro) > SvIV (sv_pool_rss)
1730	\|\| av_len (av_async_pool) + 1 >= SvIV (sv_pool_size))	1757	\|\| av_len (av_async_pool) + 1 >= SvIV (sv_pool_size))
1731	croak ("\3terminate\2\n");	1758	croak ("\3terminate\2\n");
1732		1759
1733	av_clear (GvAV (PL_defgv));	1760	av_clear (GvAV (PL_defgv));
1734	hv_store ((HV *)SvRV (coro_current), "desc", sizeof ("desc") - 1,	1761	hv_store ((HV *)SvRV (coro_current), "desc", sizeof ("desc") - 1,
1735	newSVpvn ("[async_pool idle]", sizeof ("[async_pool idle]") - 1), 0);	1762	newSVpvn ("[async_pool idle]", sizeof ("[async_pool idle]") - 1), 0);
1736	coro->save = CORO_SAVE_DEF;	1763
1737	coro->prio = 0;	1764	coro->prio = 0;
		1765
		1766	if (coro->cctx && (coro->cctx->flags & CC_TRACE))
		1767	api_trace (coro_current, 0);
		1768
1738	av_push (av_async_pool, newSVsv (coro_current));	1769	av_push (av_async_pool, newSVsv (coro_current));
1739	}	1770	}
1740		1771
1741		1772
1742	MODULE = Coro::State PACKAGE = Coro::AIO	1773	MODULE = Coro::State PACKAGE = Coro::AIO

Diff Legend

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

Comparing Coro/Coro/State.xs (file contents): Revision 1.168 by root, Thu Sep 27 16:10:48 2007 UTC vs. Revision 1.184 by root, Thu Oct 4 13:45:56 2007 UTC

Diff Legend

Comparing Coro/Coro/State.xs (file contents):
Revision 1.168 by root, Thu Sep 27 16:10:48 2007 UTC vs.
Revision 1.184 by root, Thu Oct 4 13:45:56 2007 UTC