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

Comparing Coro/Coro/State.xs (file contents):
Revision 1.10 by root, Sat Jul 21 04:19:34 2001 UTC vs.
Revision 1.14 by root, Mon Jul 23 23:48:05 2001 UTC

…		…
1	#include "EXTERN.h"	1	#include "EXTERN.h"
2	#include "perl.h"	2	#include "perl.h"
3	#include "XSUB.h"	3	#include "XSUB.h"
4		4
5	#if 1	5	#include "libcoro/coro.c"
6	# define CHK(x) (void *)0	6
7	#else	7	#ifdef HAVE_MMAP
8	# define CHK(x) if (!(x)) croak("FATAL, CHK: " #x)	8	# include <unistd.h>
		9	# include <sys/mman.h>
9	#endif	10	#endif
10		11
11	#define MAY_FLUSH /* increases codesize */	12	#define MAY_FLUSH /* increases codesize */
12		13
13	#define SUB_INIT "Coro::State::coroutine_initialization"
14
15	#define SAVE_DEFAV 0x00000001	14	#define TRANSFER_SAVE_DEFAV 0x00000001
16	#define SAVE_DEFSV 0x00000002	15	#define TRANSFER_SAVE_DEFSV 0x00000002
17	#define SAVE_ERRSV 0x00000004	16	#define TRANSFER_SAVE_ERRSV 0x00000004
		17	#define TRANSFER_SAVE_CCTXT 0x00000008
18		18
19	#define SAVE_ALL -1	19	#define TRANSFER_SAVE_ALL -1
		20
		21	#define SUB_INIT "Coro::State::initialize"
		22	#define UCORO_STATE "_coro_state"
20		23
21	struct coro {	24	struct coro {
		25	/* the optional C context */
		26	coro_context cctx;
		27	void *sptr;
		28	long ssize;
		29
22	/* optionally saved, might be zero */	30	/* optionally saved, might be zero */
23	AV *defav;	31	AV *defav;
24	SV *defsv;	32	SV *defsv;
25	SV *errsv;	33	SV *errsv;
26		34
51	I32 savestack_max;	59	I32 savestack_max;
52	OP **retstack;	60	OP **retstack;
53	I32 retstack_ix;	61	I32 retstack_ix;
54	I32 retstack_max;	62	I32 retstack_max;
55	COP *curcop;	63	COP *curcop;
		64	JMPENV start_env;
		65	JMPENV *top_env;
56		66
57	/* data associated with this coroutine (initial args) */	67	/* data associated with this coroutine (initial args) */
58	AV *args;	68	AV *args;
59	};	69	};
60		70
61	typedef struct coro *Coro__State;	71	typedef struct coro *Coro__State;
62	typedef struct coro *Coro__State_or_hashref;	72	typedef struct coro *Coro__State_or_hashref;
63		73
		74	static AV main_mainstack; / used to differentiate between $main and others */
		75	static HV *coro_state_stash;
		76	static SV *ucoro_state_sv;
		77	static U32 ucoro_state_hash;
64	static HV *padlist_cache;	78	static HV *padlist_cache;
65		79
66	/* mostly copied from op.c:cv_clone2 */	80	/* mostly copied from op.c:cv_clone2 */
67	STATIC AV *	81	STATIC AV *
68	clone_padlist (AV *protopadlist)	82	clone_padlist (AV *protopadlist)
…		…
231	#endif	245	#endif
232		246
233	#define SB do {	247	#define SB do {
234	#define SE } while (0)	248	#define SE } while (0)
235		249
236	#define LOAD(state) SB load_state(aTHX_ state); SPAGAIN; SE	250	#define LOAD(state) SB load_state(aTHX_ (state)); SPAGAIN; SE
237	#define SAVE(state,flags) SB PUTBACK; save_state(aTHX_ state,flags); SE	251	#define SAVE(state,flags) SB PUTBACK; save_state(aTHX_ (state),(flags)); SE
238		252
239	#define REPLACE_SV(sv,val) SB SvREFCNT_dec(sv); (sv) = (val); SE	253	#define REPLACE_SV(sv,val) SB SvREFCNT_dec(sv); (sv) = (val); SE
240		254
241	static void	255	static void
242	load_state(pTHX_ Coro__State c)	256	load_state(pTHX_ Coro__State c)
…		…
266	PL_savestack_max = c->savestack_max;	280	PL_savestack_max = c->savestack_max;
267	PL_retstack = c->retstack;	281	PL_retstack = c->retstack;
268	PL_retstack_ix = c->retstack_ix;	282	PL_retstack_ix = c->retstack_ix;
269	PL_retstack_max = c->retstack_max;	283	PL_retstack_max = c->retstack_max;
270	PL_curcop = c->curcop;	284	PL_curcop = c->curcop;
		285	PL_start_env = c->start_env;
		286	PL_top_env = c->top_env;
271		287
272	if (c->defav) REPLACE_SV (GvAV (PL_defgv), c->defav);	288	if (c->defav) REPLACE_SV (GvAV (PL_defgv), c->defav);
273	if (c->defsv) REPLACE_SV (DEFSV , c->defsv);	289	if (c->defsv) REPLACE_SV (DEFSV , c->defsv);
274	if (c->errsv) REPLACE_SV (ERRSV , c->errsv);	290	if (c->errsv) REPLACE_SV (ERRSV , c->errsv);
275		291
…		…
302	save_state(pTHX_ Coro__State c, int flags)	318	save_state(pTHX_ Coro__State c, int flags)
303	{	319	{
304	{	320	{
305	dSP;	321	dSP;
306	I32 cxix = cxstack_ix;	322	I32 cxix = cxstack_ix;
		323	PERL_CONTEXT *ccstk = cxstack;
307	PERL_SI *top_si = PL_curstackinfo;	324	PERL_SI *top_si = PL_curstackinfo;
308	PERL_CONTEXT *ccstk = cxstack;
309		325
310	/*	326	/*
311	* the worst thing you can imagine happens first - we have to save	327	* the worst thing you can imagine happens first - we have to save
312	* (and reinitialize) all cv's in the whole callchain :(	328	* (and reinitialize) all cv's in the whole callchain :(
313	*/	329	*/
314		330
315	PUSHs (Nullsv);	331	PUSHs (Nullsv);
316	/* this loop was inspired by pp_caller */	332	/* this loop was inspired by pp_caller */
317	for (;;)	333	for (;;)
318	{	334	{
319	do	335	do
320	{	336	{
321	PERL_CONTEXT *cx = &ccstk[cxix--];	337	PERL_CONTEXT *cx = &ccstk[cxix--];
322		338
323	if (CxTYPE(cx) == CXt_SUB)	339	if (CxTYPE(cx) == CXt_SUB)
324	{	340	{
…		…
363	}	379	}
364		380
365	PUTBACK;	381	PUTBACK;
366	}	382	}
367		383
368	c->defav = flags & SAVE_DEFAV ? (AV *)SvREFCNT_inc (GvAV (PL_defgv)) : 0;	384	c->defav = flags & TRANSFER_SAVE_DEFAV ? (AV *)SvREFCNT_inc (GvAV (PL_defgv)) : 0;
369	c->defsv = flags & SAVE_DEFSV ? SvREFCNT_inc (DEFSV) : 0;	385	c->defsv = flags & TRANSFER_SAVE_DEFSV ? SvREFCNT_inc (DEFSV) : 0;
370	c->errsv = flags & SAVE_ERRSV ? SvREFCNT_inc (ERRSV) : 0;	386	c->errsv = flags & TRANSFER_SAVE_ERRSV ? SvREFCNT_inc (ERRSV) : 0;
		387
		388	/* I have not the slightest idea of why av_reify is necessary */
		389	/* but if it's missing the defav contents magically get replaced sometimes */
		390	if (c->defav)
		391	av_reify (c->defav);
371		392
372	c->dowarn = PL_dowarn;	393	c->dowarn = PL_dowarn;
373		394
374	c->curstackinfo = PL_curstackinfo;	395	c->curstackinfo = PL_curstackinfo;
375	c->curstack = PL_curstack;	396	c->curstack = PL_curstack;
…		…
394	c->savestack_max = PL_savestack_max;	415	c->savestack_max = PL_savestack_max;
395	c->retstack = PL_retstack;	416	c->retstack = PL_retstack;
396	c->retstack_ix = PL_retstack_ix;	417	c->retstack_ix = PL_retstack_ix;
397	c->retstack_max = PL_retstack_max;	418	c->retstack_max = PL_retstack_max;
398	c->curcop = PL_curcop;	419	c->curcop = PL_curcop;
		420	c->start_env = PL_start_env;
		421	c->top_env = PL_top_env;
		422	}
		423
		424	/*
		425	* allocate various perl stacks. This is an exact copy
		426	* of perl.c:init_stacks, except that it uses less memory
		427	* on the assumption that coroutines do not usually need
		428	* a lot of stackspace.
		429	*/
		430	STATIC void
		431	coro_init_stacks (pTHX)
		432	{
		433	PL_curstackinfo = new_stackinfo(96, 1024/sizeof(PERL_CONTEXT) - 1);
		434	PL_curstackinfo->si_type = PERLSI_MAIN;
		435	PL_curstack = PL_curstackinfo->si_stack;
		436	PL_mainstack = PL_curstack; /* remember in case we switch stacks */
		437
		438	PL_stack_base = AvARRAY(PL_curstack);
		439	PL_stack_sp = PL_stack_base;
		440	PL_stack_max = PL_stack_base + AvMAX(PL_curstack);
		441
		442	New(50,PL_tmps_stack,64,SV*);
		443	PL_tmps_floor = -1;
		444	PL_tmps_ix = -1;
		445	PL_tmps_max = 64;
		446
		447	New(54,PL_markstack,12,I32);
		448	PL_markstack_ptr = PL_markstack;
		449	PL_markstack_max = PL_markstack + 12;
		450
		451	SET_MARK_OFFSET;
		452
		453	New(54,PL_scopestack,12,I32);
		454	PL_scopestack_ix = 0;
		455	PL_scopestack_max = 12;
		456
		457	New(54,PL_savestack,64,ANY);
		458	PL_savestack_ix = 0;
		459	PL_savestack_max = 64;
		460
		461	New(54,PL_retstack,8,OP*);
		462	PL_retstack_ix = 0;
		463	PL_retstack_max = 8;
399	}	464	}
400		465
401	/*	466	/*
402	* destroy the stacks, the callchain etc...	467	* destroy the stacks, the callchain etc...
403	* still there is a memleak of 128 bytes...	468	* still there is a memleak of 128 bytes...
…		…
439	Safefree(PL_scopestack);	504	Safefree(PL_scopestack);
440	Safefree(PL_savestack);	505	Safefree(PL_savestack);
441	Safefree(PL_retstack);	506	Safefree(PL_retstack);
442	}	507	}
443		508
		509	static void
		510	allocate_stack (Coro__State ctx)
		511	{
		512	#ifdef HAVE_MMAP
		513	ctx->ssize = 128 * 1024 * sizeof (long); /* mmap should do allocate-on-use */
		514	ctx->sptr = mmap (0, ctx->ssize, PROT_EXEC\|PROT_READ\|PROT_WRITE, MAP_PRIVATE\|MAP_ANON, 0, 0);
		515	if (ctx->sptr == (void *)-1)
		516	#endif
		517	{
		518	/FIXME//D//* reasonable stack size! */
		519	ctx->ssize = 4096 * sizeof (long);
		520	New (0, ctx->sptr, 4096, long);
		521	}
		522	}
		523
		524	static void
		525	deallocate_stack (Coro__State ctx)
		526	{
		527	#ifdef HAVE_MMAP
		528	munmap (ctx->sptr, ctx->ssize);
		529	#else
		530	Safefree (ctx->sptr);
		531	#endif
		532	}
		533
		534	/* might go away together with optional SAVE_CCTXT */
		535	static void
		536	setup_coro (void *arg)
		537	{
		538	/*
		539	* emulate part of the perl startup here.
		540	*/
		541	dSP;
		542	Coro__State ctx = (Coro__State)arg;
		543	SV sub_init = (SV)get_cv(SUB_INIT, FALSE);
		544
		545	coro_init_stacks (aTHX);
		546	JMPENV_BOOTSTRAP;
		547	SPAGAIN;
		548
		549	/PL_curcop = 0;/
		550	SvREFCNT_dec (GvAV (PL_defgv));
		551	GvAV (PL_defgv) = ctx->args;
		552
		553	if (ctx->sptr)
		554	{
		555	PUSHMARK(SP);
		556	PUTBACK;
		557	(void) call_sv (sub_init, G_VOID\|G_NOARGS);
		558	croak ("FATAL: CCTXT coroutine returned!");
		559	}
		560	else
		561	{
		562	UNOP myop;
		563
		564	PL_op = (OP *)&myop;
		565
		566	Zero(&myop, 1, UNOP);
		567	myop.op_next = Nullop;
		568	myop.op_flags = OPf_WANT_VOID;
		569
		570	PUSHMARK(SP);
		571	XPUSHs (sub_init);
		572	/*
		573	* the next line is slightly wrong, as PL_op->op_next
		574	* is actually being executed so we skip the first op.
		575	* that doesn't matter, though, since it is only
		576	* pp_nextstate and we never return...
		577	* ah yes, and I don't care anyways ;)
		578	*/
		579	PUTBACK;
		580	PL_op = pp_entersub();
		581	SPAGAIN;
		582
		583	ENTER; /* necessary e.g. for dounwind */
		584	}
		585	}
		586
444	STATIC void	587	STATIC void
445	transfer(pTHX_ struct coro prev, struct coro next, int flags)	588	transfer(pTHX_ struct coro prev, struct coro next, int flags)
446	{	589	{
447	dSP;	590	dSP;
448		591
449	if (prev != next)	592	if (prev != next)
450	{	593	{
451	/*	594	/*
452	* this could be done in newprocess which would lead to	595	* this could be done in newprocess which would lead to
453	* extremely elegant and fast (just SAVE/LOAD)	596	* extremely elegant and fast (basically just SAVE/LOAD)
454	* code here, but lazy allocation of stacks has also	597	* code here, but lazy allocation of stacks has also
455	* some virtues and the overhead of the if() is nil.	598	* some virtues and the overhead of the if() is nil.
456	*/	599	*/
457	if (next->mainstack)	600	if (next->mainstack)
458	{	601	{
459	SAVE (prev, flags);	602	SAVE (prev, flags);
460	LOAD (next);	603	LOAD (next);
		604
461	/* mark this state as in-use */	605	/* mark this state as in-use */
462	next->mainstack = 0;	606	next->mainstack = 0;
463	next->tmps_ix = -2;	607	next->tmps_ix = -2;
		608
		609	if (flags & TRANSFER_SAVE_CCTXT)
		610	{
		611	if (!next->ssize)
		612	croak ("destination coroutine has no CCTXT (%p, %d)", next->sptr, next->ssize);
		613
		614	if (!prev->ssize)
		615	prev->ssize = 1; /* mark cctx as valid ;) */
		616
		617	coro_transfer (&(prev->cctx), &(next->cctx));
		618	}
		619
464	}	620	}
465	else if (next->tmps_ix == -2)	621	else if (next->tmps_ix == -2)
466	{
467	croak ("tried to transfer to running coroutine");	622	croak ("tried to transfer to running coroutine");
468	}
469	else	623	else
470	{	624	{
471	/*
472	* emulate part of the perl startup here.
473	*/
474	UNOP myop;
475
476	SAVE (prev, -1); /* first get rid of the old state */	625	SAVE (prev, -1); /* first get rid of the old state */
477		626
478	init_stacks (); /* from perl.c */	627	if (flags & TRANSFER_SAVE_CCTXT)
479	SPAGAIN;
480
481	PL_op = (OP *)&myop;
482	/PL_curcop = 0;/
483	SvREFCNT_dec (GvAV (PL_defgv));
484	GvAV (PL_defgv) = next->args;
485
486	Zero(&myop, 1, UNOP);
487	myop.op_next = Nullop;
488	myop.op_flags = OPf_WANT_VOID;
489
490	PUSHMARK(SP);
491	XPUSHs ((SV*)get_cv(SUB_INIT, TRUE));
492	/*
493	* the next line is slightly wrong, as PL_op->op_next
494	* is actually being executed so we skip the first op.
495	* that doesn't matter, though, since it is only
496	* pp_nextstate and we never return...
497	* ah yes, and I don't care anyways ;)
498	*/	628	{
499	PUTBACK;	629	if (!next->ssize)
500	PL_op = pp_entersub(aTHX);	630	{
501	SPAGAIN;	631	allocate_stack (next);
		632	coro_create (&(next->cctx),
		633	setup_coro, (void *)next,
		634	next->sptr, next->ssize);
		635	}
502		636
503	ENTER; /* necessary e.g. for dounwind */	637	if (!prev->ssize)
		638	prev->ssize = 1; /* mark cctx as valid ;) */
		639
		640	coro_transfer (&(prev->cctx), &(next->cctx));
		641	}
		642	else
		643	setup_coro (next);
504	}	644	}
505	}	645	}
506	}	646	}
507		647
508	MODULE = Coro::State PACKAGE = Coro::State	648	MODULE = Coro::State PACKAGE = Coro::State
509		649
510	PROTOTYPES: ENABLE	650	PROTOTYPES: ENABLE
511		651
512	BOOT:	652	BOOT:
513	{ /* {} necessary for stoopid perl-5.6.x */	653	{ /* {} necessary for stoopid perl-5.6.x */
		654	ucoro_state_sv = newSVpv (UCORO_STATE, sizeof(UCORO_STATE) - 1);
		655	PERL_HASH(ucoro_state_hash, UCORO_STATE, sizeof(UCORO_STATE) - 1);
514	HV * stash = gv_stashpvn("Coro::State", 10, TRUE);	656	coro_state_stash = gv_stashpv ("Coro::State", TRUE);
515		657
516	newCONSTSUB (stash, "SAVE_DEFAV", newSViv (SAVE_DEFAV));	658	newCONSTSUB (coro_state_stash, "SAVE_DEFAV", newSViv (TRANSFER_SAVE_DEFAV));
517	newCONSTSUB (stash, "SAVE_DEFSV", newSViv (SAVE_DEFSV));	659	newCONSTSUB (coro_state_stash, "SAVE_DEFSV", newSViv (TRANSFER_SAVE_DEFSV));
518	newCONSTSUB (stash, "SAVE_ERRSV", newSViv (SAVE_ERRSV));	660	newCONSTSUB (coro_state_stash, "SAVE_ERRSV", newSViv (TRANSFER_SAVE_ERRSV));
		661	newCONSTSUB (coro_state_stash, "SAVE_CCTXT", newSViv (TRANSFER_SAVE_CCTXT));
519		662
520	if (!padlist_cache)	663	if (!padlist_cache)
521	padlist_cache = newHV ();	664	padlist_cache = newHV ();
		665
		666	main_mainstack = PL_mainstack;
522	}	667	}
523		668
524	Coro::State	669	Coro::State
525	_newprocess(args)	670	_newprocess(args)
526	SV * args	671	SV * args
…		…
531	if (!SvROK (args) \|\| SvTYPE (SvRV (args)) != SVt_PVAV)	676	if (!SvROK (args) \|\| SvTYPE (SvRV (args)) != SVt_PVAV)
532	croak ("Coro::State::_newprocess expects an arrayref");	677	croak ("Coro::State::_newprocess expects an arrayref");
533		678
534	New (0, coro, 1, struct coro);	679	New (0, coro, 1, struct coro);
535		680
		681	coro->args = (AV *)SvREFCNT_inc (SvRV (args));
536	coro->mainstack = 0; /* actual work is done inside transfer */	682	coro->mainstack = 0; /* actual work is done inside transfer */
537	coro->args = (AV *)SvREFCNT_inc (SvRV (args));	683	coro->sptr = 0;
		684	coro->ssize = 0;
538		685
539	RETVAL = coro;	686	RETVAL = coro;
540	OUTPUT:	687	OUTPUT:
541	RETVAL	688	RETVAL
542		689
543	void	690	void
544	transfer(prev, next, flags = SAVE_DEFAV)	691	transfer(prev, next, flags = TRANSFER_SAVE_ALL)
545	Coro::State_or_hashref prev	692	Coro::State_or_hashref prev
546	Coro::State_or_hashref next	693	Coro::State_or_hashref next
547	int flags	694	int flags
548	PROTOTYPE: @	695	PROTOTYPE: @
549	CODE:	696	CODE:
550
551	transfer (aTHX_ prev, next, flags);	697	transfer (aTHX_ prev, next, flags);
552		698
553	void	699	void
554	DESTROY(coro)	700	DESTROY(coro)
555	Coro::State coro	701	Coro::State coro
556	CODE:	702	CODE:
557		703
558	if (coro->mainstack)	704	if (coro->mainstack && coro->mainstack != main_mainstack)
559	{	705	{
560	struct coro temp;	706	struct coro temp;
561		707
562	SAVE(aTHX_ (&temp), SAVE_ALL);	708	SAVE(aTHX_ (&temp), TRANSFER_SAVE_ALL);
563	LOAD(aTHX_ coro);	709	LOAD(aTHX_ coro);
564		710
565	destroy_stacks ();	711	destroy_stacks (aTHX);
566		712
567	LOAD((&temp)); /* this will get rid of defsv etc.. */	713	LOAD((&temp)); /* this will get rid of defsv etc.. */
		714
		715	coro->mainstack = 0;
		716	}
		717
		718	if (coro->sptr)
		719	{
		720	deallocate_stack (coro);
		721	coro->sptr = 0;
568	}	722	}
569		723
570	Safefree (coro);	724	Safefree (coro);
571		725
572	void	726	void
…		…
576	flush_padlist_cache ();	730	flush_padlist_cache ();
577	#endif	731	#endif
578		732
579	MODULE = Coro::State PACKAGE = Coro::Cont	733	MODULE = Coro::State PACKAGE = Coro::Cont
580		734
581	# this is dirty and should be in it's own .xs	735	# this is slightly dirty
582		736
583	void	737	void
584	result(...)	738	yield(...)
585	PROTOTYPE: @	739	PROTOTYPE: @
586	CODE:	740	CODE:
587	static SV *returnstk;	741	static SV *returnstk;
588	SV *sv;	742	SV *sv;
589	AV *defav = GvAV (PL_defgv);	743	AV *defav = GvAV (PL_defgv);
590	struct coro prev, next;	744	struct coro prev, next;
591		745
592	if (!returnstk)	746	if (!returnstk)
593	returnstk = SvRV (get_sv ("Coro::Cont::return", FALSE));	747	returnstk = SvRV (get_sv ("Coro::Cont::return", FALSE));
594		748
595	/* set up @_ */	749	/* set up @_ -- ugly */
596	av_clear (defav);	750	av_clear (defav);
597	av_fill (defav, items - 1);	751	av_fill (defav, items - 1);
598	while (items--)	752	while (items--)
599	av_store (defav, items, SvREFCNT_inc (ST(items)));	753	av_store (defav, items, SvREFCNT_inc (ST(items)));
600		754
601	mg_get (returnstk); /* isn't documentation wrong for mg_get? */	755	mg_get (returnstk); /* isn't documentation wrong for mg_get? */
602	sv = av_pop ((AV *)SvRV (returnstk));	756	sv = av_pop ((AV *)SvRV (returnstk));
603	prev = (struct coro )SvIV ((SV)SvRV (av_fetch ((AV )SvRV (sv), 0, 0)));	757	prev = (struct coro )SvIV ((SV)SvRV (av_fetch ((AV )SvRV (sv), 0, 0)));
604	next = (struct coro )SvIV ((SV)SvRV (av_fetch ((AV )SvRV (sv), 1, 0)));	758	next = (struct coro )SvIV ((SV)SvRV (av_fetch ((AV )SvRV (sv), 1, 0)));
605	SvREFCNT_dec (sv);	759	SvREFCNT_dec (sv);
		760
606	transfer(prev, next, 0);	761	transfer(aTHX_ prev, next, 0);
607		762

Diff Legend

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

Comparing Coro/Coro/State.xs (file contents): Revision 1.10 by root, Sat Jul 21 04:19:34 2001 UTC vs. Revision 1.14 by root, Mon Jul 23 23:48:05 2001 UTC

Diff Legend

Comparing Coro/Coro/State.xs (file contents):
Revision 1.10 by root, Sat Jul 21 04:19:34 2001 UTC vs.
Revision 1.14 by root, Mon Jul 23 23:48:05 2001 UTC