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

Comparing Coro/Coro/State.xs (file contents):
Revision 1.98 by root, Sun Nov 26 21:25:53 2006 UTC vs.
Revision 1.103 by root, Mon Nov 27 01:33:30 2006 UTC

…		…
4	#include "perl.h"	4	#include "perl.h"
5	#include "XSUB.h"	5	#include "XSUB.h"
6		6
7	#include "patchlevel.h"	7	#include "patchlevel.h"
8		8
9	#if PERL_VERSION < 6	9	#define PERL_VERSION_ATLEAST(a,b,c) \
		10	(PERL_REVISION > (a) \
		11	\|\| (PERL_REVISION == (a) \
		12	&& (PERL_VERSION > (b) \
		13	\|\| (PERL_VERSION == (b) && PERLSUBVERSION >= (c)))))
		14
		15	#if !PERL_VERSION_ATLEAST (5,6,0)
10	# ifndef PL_ppaddr	16	# ifndef PL_ppaddr
11	# define PL_ppaddr ppaddr	17	# define PL_ppaddr ppaddr
12	# endif	18	# endif
13	# ifndef call_sv	19	# ifndef call_sv
14	# define call_sv perl_call_sv	20	# define call_sv perl_call_sv
…		…
63	* and should be unique. */	69	* and should be unique. */
64	#define dSTACKLEVEL int stacklevel	70	#define dSTACKLEVEL int stacklevel
65	#define STACKLEVEL ((void *)&stacklevel)	71	#define STACKLEVEL ((void *)&stacklevel)
66		72
67	#define IN_DESTRUCT (PL_main_cv == Nullcv)	73	#define IN_DESTRUCT (PL_main_cv == Nullcv)
		74
		75	#if __GNUC__ >= 3
		76	# define attribute(x) __attribute__(x)
		77	#else
		78	# define attribute(x)
		79	#endif
		80
		81	#define NOINLINE attribute ((noinline))
68		82
69	#include "CoroAPI.h"	83	#include "CoroAPI.h"
70		84
71	#define TRANSFER_SET_STACKLEVEL 0x8bfbfbfb /* magic cookie */	85	#define TRANSFER_SET_STACKLEVEL 0x8bfbfbfb /* magic cookie */
72		86
…		…
159	AV *padlist = CvPADLIST (cv);	173	AV *padlist = CvPADLIST (cv);
160	AV newpadlist, newpad;	174	AV newpadlist, newpad;
161		175
162	newpadlist = newAV ();	176	newpadlist = newAV ();
163	AvREAL_off (newpadlist);	177	AvREAL_off (newpadlist);
164	#if PERL_VERSION < 9	178	#if PERL_VERSION_ATLEAST (5,9,0)
		179	Perl_pad_push (aTHX_ padlist, AvFILLp (padlist) + 1);
		180	#else
165	Perl_pad_push (aTHX_ padlist, AvFILLp (padlist) + 1, 1);	181	Perl_pad_push (aTHX_ padlist, AvFILLp (padlist) + 1, 1);
166	#else
167	Perl_pad_push (aTHX_ padlist, AvFILLp (padlist) + 1);
168	#endif	182	#endif
169	newpad = (AV *)AvARRAY (padlist)[AvFILLp (padlist)];	183	newpad = (AV *)AvARRAY (padlist)[AvFILLp (padlist)];
170	--AvFILLp (padlist);	184	--AvFILLp (padlist);
171		185
172	av_store (newpadlist, 0, SvREFCNT_inc (*av_fetch (padlist, 0, FALSE)));	186	av_store (newpadlist, 0, SvREFCNT_inc (*av_fetch (padlist, 0, FALSE)));
…		…
291	PL_scopestack_ix = c->scopestack_ix;	305	PL_scopestack_ix = c->scopestack_ix;
292	PL_scopestack_max = c->scopestack_max;	306	PL_scopestack_max = c->scopestack_max;
293	PL_savestack = c->savestack;	307	PL_savestack = c->savestack;
294	PL_savestack_ix = c->savestack_ix;	308	PL_savestack_ix = c->savestack_ix;
295	PL_savestack_max = c->savestack_max;	309	PL_savestack_max = c->savestack_max;
296	#if PERL_VERSION < 9	310	#if !PERL_VERSION_ATLEAST (5,9,0)
297	PL_retstack = c->retstack;	311	PL_retstack = c->retstack;
298	PL_retstack_ix = c->retstack_ix;	312	PL_retstack_ix = c->retstack_ix;
299	PL_retstack_max = c->retstack_max;	313	PL_retstack_max = c->retstack_max;
300	#endif	314	#endif
301	PL_curpm = c->curpm;	315	PL_curpm = c->curpm;
…		…
418	c->scopestack_ix = PL_scopestack_ix;	432	c->scopestack_ix = PL_scopestack_ix;
419	c->scopestack_max = PL_scopestack_max;	433	c->scopestack_max = PL_scopestack_max;
420	c->savestack = PL_savestack;	434	c->savestack = PL_savestack;
421	c->savestack_ix = PL_savestack_ix;	435	c->savestack_ix = PL_savestack_ix;
422	c->savestack_max = PL_savestack_max;	436	c->savestack_max = PL_savestack_max;
423	#if PERL_VERSION < 9	437	#if !PERL_VERSION_ATLEAST (5,9,0)
424	c->retstack = PL_retstack;	438	c->retstack = PL_retstack;
425	c->retstack_ix = PL_retstack_ix;	439	c->retstack_ix = PL_retstack_ix;
426	c->retstack_max = PL_retstack_max;	440	c->retstack_max = PL_retstack_max;
427	#endif	441	#endif
428	c->curpm = PL_curpm;	442	c->curpm = PL_curpm;
…		…
436	* not usually need a lot of stackspace.	450	* not usually need a lot of stackspace.
437	*/	451	*/
438	static void	452	static void
439	coro_init_stacks ()	453	coro_init_stacks ()
440	{	454	{
441	LOCK;
442
443	PL_curstackinfo = new_stackinfo(96, 1024/sizeof(PERL_CONTEXT) - 1);	455	PL_curstackinfo = new_stackinfo(96, 1024/sizeof(PERL_CONTEXT) - 1);
444	PL_curstackinfo->si_type = PERLSI_MAIN;	456	PL_curstackinfo->si_type = PERLSI_MAIN;
445	PL_curstack = PL_curstackinfo->si_stack;	457	PL_curstack = PL_curstackinfo->si_stack;
446	PL_mainstack = PL_curstack; /* remember in case we switch stacks */	458	PL_mainstack = PL_curstack; /* remember in case we switch stacks */
447		459
…		…
468		480
469	New(54,PL_savestack,96,ANY);	481	New(54,PL_savestack,96,ANY);
470	PL_savestack_ix = 0;	482	PL_savestack_ix = 0;
471	PL_savestack_max = 96;	483	PL_savestack_max = 96;
472		484
473	#if PERL_VERSION < 9	485	#if !PERL_VERSION_ATLEAST (5,9,0)
474	New(54,PL_retstack,8,OP*);	486	New(54,PL_retstack,8,OP*);
475	PL_retstack_ix = 0;	487	PL_retstack_ix = 0;
476	PL_retstack_max = 8;	488	PL_retstack_max = 8;
477	#endif	489	#endif
478
479	UNLOCK;
480	}	490	}
481		491
482	/*	492	/*
483	* destroy the stacks, the callchain etc...	493	* destroy the stacks, the callchain etc...
484	*/	494	*/
485	static void	495	static void
486	destroy_stacks()	496	coro_destroy_stacks()
487	{	497	{
488	if (!IN_DESTRUCT)	498	if (!IN_DESTRUCT)
489	{	499	{
490	/* is this ugly, I ask? */	500	/* is this ugly, I ask? */
491	LEAVE_SCOPE (0);	501	LEAVE_SCOPE (0);
…		…
522		532
523	Safefree (PL_tmps_stack);	533	Safefree (PL_tmps_stack);
524	Safefree (PL_markstack);	534	Safefree (PL_markstack);
525	Safefree (PL_scopestack);	535	Safefree (PL_scopestack);
526	Safefree (PL_savestack);	536	Safefree (PL_savestack);
527	#if PERL_VERSION < 9	537	#if !PERL_VERSION_ATLEAST (5,9,0)
528	Safefree (PL_retstack);	538	Safefree (PL_retstack);
529	#endif	539	#endif
530	}	540	}
531		541
532	static void	542	static void
533	setup_coro (struct coro *coro)	543	setup_coro (struct coro *coro)
534	{	544	{
535	/*	545	/*
536	* emulate part of the perl startup here.	546	* emulate part of the perl startup here.
537	*/	547	*/
538	dTHX;
539	dSP;
540	UNOP myop;
541	SV sub_init = (SV )get_cv ("Coro::State::coro_init", FALSE);
542		548
543	coro_init_stacks ();	549	coro_init_stacks ();
		550
544	/PL_curcop = 0;/	551	PL_curcop = 0;
545	/PL_in_eval = PL_in_eval;/ /* inherit */	552	PL_in_eval = 0;
		553	PL_curpm = 0;
		554
		555	{
		556	dSP;
		557	LOGOP myop;
		558
		559	/* I have no idea why this is needed, but it is */
		560	PUSHMARK (SP);
		561
546	SvREFCNT_dec (GvAV (PL_defgv));	562	SvREFCNT_dec (GvAV (PL_defgv));
547	GvAV (PL_defgv) = coro->args; coro->args = 0;	563	GvAV (PL_defgv) = coro->args; coro->args = 0;
548		564
549	SPAGAIN;
550
551	Zero (&myop, 1, UNOP);	565	Zero (&myop, 1, LOGOP);
552	myop.op_next = Nullop;	566	myop.op_next = Nullop;
553	myop.op_flags = OPf_WANT_VOID;	567	myop.op_flags = OPf_WANT_VOID;
554		568
555	PL_op = (OP *)&myop;	569	PL_op = (OP *)&myop;
556		570
557	PUSHMARK(SP);	571	PUSHMARK (SP);
558	XPUSHs (sub_init);	572	XPUSHs ((SV *)get_cv ("Coro::State::coro_init", FALSE));
559	PUTBACK;	573	PUTBACK;
560	PL_op = PL_ppaddr[OP_ENTERSUB](aTHX);	574	PL_op = PL_ppaddr[OP_ENTERSUB](aTHX);
561	SPAGAIN;	575	SPAGAIN;
562		576
563	ENTER; /* necessary e.g. for dounwind */	577	ENTER; /* necessary e.g. for dounwind */
		578	}
564	}	579	}
565		580
566	static void	581	static void
567	free_coro_mortal ()	582	free_coro_mortal ()
568	{	583	{
…		…
571	SvREFCNT_dec (coro_mortal);	586	SvREFCNT_dec (coro_mortal);
572	coro_mortal = 0;	587	coro_mortal = 0;
573	}	588	}
574	}	589	}
575		590
		591	static void NOINLINE
		592	prepare_cctx (coro_stack *cctx)
		593	{
		594	dSP;
		595	LOGOP myop;
		596
		597	Zero (&myop, 1, LOGOP);
		598	myop.op_next = PL_op;
		599	myop.op_flags = OPf_WANT_VOID;
		600
		601	sv_setiv (get_sv ("Coro::State::cctx_stack", FALSE), PTR2IV (cctx));
		602
		603	PUSHMARK (SP);
		604	XPUSHs ((SV *)get_cv ("Coro::State::cctx_init", FALSE));
		605	PUTBACK;
		606	PL_restartop = PL_ppaddr[OP_ENTERSUB](aTHX);
		607	SPAGAIN;
		608	}
		609
576	static void	610	static void
577	coro_run (void *arg)	611	coro_run (void *arg)
578	{	612	{
		613	/* coro_run is the alternative epilogue of transfer() */
		614	UNLOCK;
		615
579	/*	616	/*
580	* this is a _very_ stripped down perl interpreter ;)	617	* this is a _very_ stripped down perl interpreter ;)
581	*/	618	*/
582	dTHX;
583	int ret;
584
585	UNLOCK;
586
587	PL_top_env = &PL_start_env;	619	PL_top_env = &PL_start_env;
588		620	/* inject call to cctx_init */
589	sv_setiv (get_sv ("Coro::State::cctx_stack", FALSE), PTR2IV ((coro_stack *)arg));	621	prepare_cctx ((coro_stack *)arg);
590	sv_setiv (get_sv ("Coro::State::cctx_restartop", FALSE), PTR2IV (PL_op));
591
592	/* continue at cctx_init, without entersub */
593	PL_restartop = CvSTART (get_cv ("Coro::State::cctx_init", FALSE));
594		622
595	/* somebody will hit me for both perl_run and PL_restartop */	623	/* somebody will hit me for both perl_run and PL_restartop */
596	ret = perl_run (PERL_GET_CONTEXT);	624	perl_run (PL_curinterp);
597	printf ("ret %d\n", ret);//D
598		625
599	fputs ("FATAL: C coroutine fell over the edge of the world, aborting.\n", stderr);	626	fputs ("FATAL: C coroutine fell over the edge of the world, aborting.\n", stderr);
600	abort ();	627	abort ();
601	}	628	}
602		629
…		…
655		682
656	Safefree (stack);	683	Safefree (stack);
657	}	684	}
658		685
659	static coro_stack *stack_first;	686	static coro_stack *stack_first;
		687	static int cctx_count, cctx_idle;
660		688
661	static coro_stack *	689	static coro_stack *
662	stack_get ()	690	stack_get ()
663	{	691	{
664	coro_stack *stack;	692	coro_stack *stack;
665		693
666	if (stack_first)	694	if (stack_first)
667	{	695	{
		696	--cctx_idle;
668	stack = stack_first;	697	stack = stack_first;
669	stack_first = stack->next;	698	stack_first = stack->next;
670	}	699	}
671	else	700	else
672	{	701	{
		702	++cctx_count;
673	stack = stack_new ();	703	stack = stack_new ();
674	PL_op = PL_op->op_next;	704	PL_op = PL_op->op_next;
675	}	705	}
676		706
677	return stack;	707	return stack;
678	}	708	}
679		709
680	static void	710	static void
681	stack_put (coro_stack *stack)	711	stack_put (coro_stack *stack)
682	{	712	{
		713	++cctx_idle;
683	stack->next = stack_first;	714	stack->next = stack_first;
684	stack_first = stack;	715	stack_first = stack;
685	}	716	}
686		717
687	/* never call directly, always through the coro_state_transfer global variable */	718	/* never call directly, always through the coro_state_transfer global variable */
688	static void	719	static void NOINLINE
689	transfer_impl (struct coro prev, struct coro next, int flags)	720	transfer (struct coro prev, struct coro next, int flags)
690	{	721	{
691	dSTACKLEVEL;	722	dSTACKLEVEL;
692		723
693	/* sometimes transfer is only called to set idle_sp */	724	/* sometimes transfer is only called to set idle_sp */
694	if (flags == TRANSFER_SET_STACKLEVEL)	725	if (flags == TRANSFER_SET_STACKLEVEL)
…		…
743		774
744	UNLOCK;	775	UNLOCK;
745	}	776	}
746	}	777	}
747		778
748	/* use this function pointer to call the above function */
749	/* this is done to increase chances of the compiler not inlining the call */
750	/* not static to make it even harder for the compiler (and theoretically impossible in most cases */
751	void (coro_state_transfer)(struct coro prev, struct coro *next, int flags) = transfer_impl;
752
753	struct transfer_args	779	struct transfer_args
754	{	780	{
755	struct coro prev, next;	781	struct coro prev, next;
756	int flags;	782	int flags;
757	};	783	};
758		784
759	#define TRANSFER(ta) coro_state_transfer ((ta).prev, (ta).next, (ta).flags)	785	#define TRANSFER(ta) transfer ((ta).prev, (ta).next, (ta).flags)
760		786
761	static void	787	static void
762	coro_state_destroy (struct coro *coro)	788	coro_state_destroy (struct coro *coro)
763	{	789	{
764	if (coro->refcnt--)	790	if (coro->refcnt--)
…		…
769	struct coro temp;	795	struct coro temp;
770		796
771	SAVE ((&temp), TRANSFER_SAVE_ALL);	797	SAVE ((&temp), TRANSFER_SAVE_ALL);
772	LOAD (coro);	798	LOAD (coro);
773		799
774	destroy_stacks ();	800	coro_destroy_stacks ();
775		801
776	LOAD ((&temp)); /* this will get rid of defsv etc.. */	802	LOAD ((&temp)); /* this will get rid of defsv etc.. */
777		803
778	coro->mainstack = 0;	804	coro->mainstack = 0;
779	}	805	}
…		…
802	++coro->refcnt;	828	++coro->refcnt;
803		829
804	return 0;	830	return 0;
805	}	831	}
806		832
807	static MGVTBL coro_state_vtbl = { 0, 0, 0, 0, coro_state_clear, 0, coro_state_dup, 0 };	833	static MGVTBL coro_state_vtbl = {
		834	0, 0, 0, 0,
		835	coro_state_clear,
		836	0,
		837	#ifdef MGf_DUP
		838	coro_state_dup,
		839	#else
		840	# define MGf_DUP 0
		841	#endif
		842	};
808		843
809	static struct coro *	844	static struct coro *
810	SvSTATE (SV *coro)	845	SvSTATE (SV *coro)
811	{	846	{
812	HV *stash;	847	HV *stash;
…		…
909	static void	944	static void
910	prepare_schedule (struct transfer_args *ta)	945	prepare_schedule (struct transfer_args *ta)
911	{	946	{
912	SV current, prev, *next;	947	SV current, prev, *next;
913		948
914	LOCK;
915
916	current = GvSV (coro_current);	949	current = GvSV (coro_current);
917		950
918	for (;;)	951	for (;;)
919	{	952	{
920	LOCK;	953	LOCK;
921
922	next = coro_deq (PRIO_MIN);	954	next = coro_deq (PRIO_MIN);
		955	UNLOCK;
923		956
924	if (next)	957	if (next)
925	break;	958	break;
926
927	UNLOCK;
928		959
929	{	960	{
930	dSP;	961	dSP;
931		962
932	ENTER;	963	ENTER;
…		…
943		974
944	prev = SvRV (current);	975	prev = SvRV (current);
945	SvRV (current) = next;	976	SvRV (current) = next;
946		977
947	/* free this only after the transfer */	978	/* free this only after the transfer */
		979	LOCK;
948	free_coro_mortal ();	980	free_coro_mortal ();
		981	UNLOCK;
949	coro_mortal = prev;	982	coro_mortal = prev;
950		983
951	ta->prev = SvSTATE (prev);	984	ta->prev = SvSTATE (prev);
952	ta->next = SvSTATE (next);	985	ta->next = SvSTATE (next);
953	ta->flags = TRANSFER_SAVE_ALL;	986	ta->flags = TRANSFER_SAVE_ALL;
954
955	UNLOCK;
956	}	987	}
957		988
958	static void	989	static void
959	prepare_cede (struct transfer_args *ta)	990	prepare_cede (struct transfer_args *ta)
960	{	991	{
…		…
1110	++coro_src->refcnt;	1141	++coro_src->refcnt;
1111	sv_magicext (SvRV (dst), 0, PERL_MAGIC_ext, &coro_state_vtbl, (char *)coro_src, 0)->mg_flags \|= MGf_DUP;	1142	sv_magicext (SvRV (dst), 0, PERL_MAGIC_ext, &coro_state_vtbl, (char *)coro_src, 0)->mg_flags \|= MGf_DUP;
1112	}	1143	}
1113		1144
1114	void	1145	void
1115	_nonlocal_goto (IV nextop)
1116	CODE:
1117	/* uuh, somebody will kill me again for this */
1118	PL_op->op_next = INT2PTR (OP *, nextop);
1119
1120	void
1121	_exit (code)	1146	_exit (code)
1122	int code	1147	int code
1123	PROTOTYPE: $	1148	PROTOTYPE: $
1124	CODE:	1149	CODE:
1125	_exit (code);	1150	_exit (code);

Diff Legend

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

Comparing Coro/Coro/State.xs (file contents): Revision 1.98 by root, Sun Nov 26 21:25:53 2006 UTC vs. Revision 1.103 by root, Mon Nov 27 01:33:30 2006 UTC

Diff Legend

Comparing Coro/Coro/State.xs (file contents):
Revision 1.98 by root, Sun Nov 26 21:25:53 2006 UTC vs.
Revision 1.103 by root, Mon Nov 27 01:33:30 2006 UTC