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

Comparing Coro/Coro/State.xs (file contents):
Revision 1.6 by root, Tue Jul 17 15:42:28 2001 UTC vs.
Revision 1.63 by root, Mon Mar 21 14:35:22 2005 UTC

…		…
		1	#define PERL_NO_GET_CONTEXT
		2
		3	#include "libcoro/coro.c"
		4
1	#include "EXTERN.h"	5	#include "EXTERN.h"
2	#include "perl.h"	6	#include "perl.h"
3	#include "XSUB.h"	7	#include "XSUB.h"
4		8
5	#if 0	9	#include "patchlevel.h"
6	# define CHK(x) (void *)0	10
		11	#if PATCHLEVEL < 6
		12	# ifndef PL_ppaddr
		13	# define PL_ppaddr ppaddr
		14	# endif
		15	# ifndef call_sv
		16	# define call_sv perl_call_sv
		17	# endif
		18	# ifndef get_sv
		19	# define get_sv perl_get_sv
		20	# endif
		21	# ifndef get_cv
		22	# define get_cv perl_get_cv
		23	# endif
		24	# ifndef IS_PADGV
		25	# define IS_PADGV(v) 0
		26	# endif
		27	# ifndef IS_PADCONST
		28	# define IS_PADCONST(v) 0
		29	# endif
		30	#endif
		31
		32	#include <signal.h>
		33
		34	#ifdef HAVE_MMAP
		35	# include <unistd.h>
		36	# include <sys/mman.h>
		37	# ifndef MAP_ANONYMOUS
		38	# ifdef MAP_ANON
		39	# define MAP_ANONYMOUS MAP_ANON
		40	# else
		41	# undef HAVE_MMAP
		42	# endif
		43	# endif
		44	#endif
		45
		46	#define SUB_INIT "Coro::State::initialize"
		47	#define UCORO_STATE "_coro_state"
		48
		49	/* The next macro should declare a variable stacklevel that contains and approximation
		50	* to the current C stack pointer. Its property is that it changes with each call
		51	* and should be unique. */
		52	#define dSTACKLEVEL void *stacklevel = &stacklevel
		53
		54	#define IN_DESTRUCT (PL_main_cv == Nullcv)
		55
		56	#define labs(l) ((l) >= 0 ? (l) : -(l))
		57
		58	#include "CoroAPI.h"
		59
		60	#ifdef USE_ITHREADS
		61	static perl_mutex coro_mutex;
		62	# define LOCK do { MUTEX_LOCK (&coro_mutex); } while (0)
		63	# define UNLOCK do { MUTEX_UNLOCK (&coro_mutex); } while (0)
7	#else	64	#else
8	# define CHK(x) if (!(x)) croak("FATAL, CHK: " #x)	65	# define LOCK 0
		66	# define UNLOCK 0
9	#endif	67	#endif
10		68
		69	static struct CoroAPI coroapi;
		70	static AV main_mainstack; / used to differentiate between $main and others */
		71	static HV *coro_state_stash;
		72	static SV *ucoro_state_sv;
		73	static U32 ucoro_state_hash;
		74	static SV coro_mortal; / will be freed after next transfer */
		75
		76	/* this is actually not only the c stack but also c registers etc... */
		77	typedef struct {
		78	int refcnt; /* pointer reference counter */
		79	int usecnt; /* shared by how many coroutines */
		80	int gencnt; /* generation counter */
		81
		82	coro_context cctx;
		83
		84	void *sptr;
		85	long ssize; /* positive == mmap, otherwise malloc */
		86	} coro_stack;
		87
11	struct coro {	88	struct coro {
		89	/* the top-level JMPENV for each coroutine, needed to catch dies. */
		90	JMPENV start_env;
		91
		92	/* the optional C context */
		93	coro_stack *stack;
		94	void *cursp;
		95	int gencnt;
		96
		97	/* optionally saved, might be zero */
		98	AV *defav;
		99	SV *defsv;
		100	SV *errsv;
		101
		102	/* saved global state not related to stacks */
12	U8 dowarn;	103	U8 dowarn;
13	AV *defav;	104	I32 in_eval;
14		105
		106	/* the stacks and related info (callchain etc..) */
15	PERL_SI *curstackinfo;	107	PERL_SI *curstackinfo;
16	AV *curstack;	108	AV *curstack;
17	AV *mainstack;	109	AV *mainstack;
18	SV **stack_sp;	110	SV **stack_sp;
19	OP *op;	111	OP *op;
20	SV **curpad;	112	SV **curpad;
		113	AV *comppad;
		114	CV *compcv;
21	SV **stack_base;	115	SV **stack_base;
22	SV **stack_max;	116	SV **stack_max;
23	SV **tmps_stack;	117	SV **tmps_stack;
24	I32 tmps_floor;	118	I32 tmps_floor;
25	I32 tmps_ix;	119	I32 tmps_ix;
35	I32 savestack_max;	129	I32 savestack_max;
36	OP **retstack;	130	OP **retstack;
37	I32 retstack_ix;	131	I32 retstack_ix;
38	I32 retstack_max;	132	I32 retstack_max;
39	COP *curcop;	133	COP *curcop;
		134	JMPENV *top_env;
40		135
		136	/* data associated with this coroutine (initial args) */
41	AV *args;	137	AV *args;
42	};	138	};
43		139
44	typedef struct coro *Coro__State;	140	typedef struct coro *Coro__State;
45	typedef struct coro *Coro__State_or_hashref;	141	typedef struct coro *Coro__State_or_hashref;
46		142
47	static HV *padlist_cache;
48
49	/* mostly copied from op.c:cv_clone2 */	143	/* mostly copied from op.c:cv_clone2 */
50	STATIC AV *	144	STATIC AV *
51	clone_padlist (AV *protopadlist)	145	clone_padlist (pTHX_ AV *protopadlist)
52	{	146	{
53	AV *av;	147	AV *av;
54	I32 ix;	148	I32 ix;
55	AV protopad_name = (AV ) * av_fetch (protopadlist, 0, FALSE);	149	AV protopad_name = (AV ) * av_fetch (protopadlist, 0, FALSE);
56	AV protopad = (AV ) * av_fetch (protopadlist, 1, FALSE);	150	AV protopad = (AV ) * av_fetch (protopadlist, 1, FALSE);
…		…
80	AvFLAGS (av) = AVf_REIFY;	174	AvFLAGS (av) = AVf_REIFY;
81		175
82	for (ix = fpad; ix > 0; ix--)	176	for (ix = fpad; ix > 0; ix--)
83	{	177	{
84	SV *namesv = (ix <= fname) ? pname[ix] : Nullsv;	178	SV *namesv = (ix <= fname) ? pname[ix] : Nullsv;
		179
85	if (namesv && namesv != &PL_sv_undef)	180	if (namesv && namesv != &PL_sv_undef)
86	{	181	{
87	char name = SvPVX (namesv); / XXX */	182	char name = SvPVX (namesv); / XXX */
		183
88	if (SvFLAGS (namesv) & SVf_FAKE \|\| *name == '&')	184	if (SvFLAGS (namesv) & SVf_FAKE \|\| *name == '&')
89	{ /* lexical from outside? */	185	{ /* lexical from outside? */
90	npad[ix] = SvREFCNT_inc (ppad[ix]);	186	npad[ix] = SvREFCNT_inc (ppad[ix]);
91	}	187	}
92	else	188	else
…		…
98	sv = (SV *) newAV ();	194	sv = (SV *) newAV ();
99	else if (*name == '%')	195	else if (*name == '%')
100	sv = (SV *) newHV ();	196	sv = (SV *) newHV ();
101	else	197	else
102	sv = NEWSV (0, 0);	198	sv = NEWSV (0, 0);
		199
		200	#ifdef SvPADBUSY
103	if (!SvPADBUSY (sv))	201	if (!SvPADBUSY (sv))
		202	#endif
104	SvPADMY_on (sv);	203	SvPADMY_on (sv);
		204
105	npad[ix] = sv;	205	npad[ix] = sv;
106	}	206	}
107	}	207	}
108	else if (IS_PADGV (ppad[ix]) \|\| IS_PADCONST (ppad[ix]))	208	else if (IS_PADGV (ppad[ix]) \|\| IS_PADCONST (ppad[ix]))
109	{	209	{
…		…
115	SvPADTMP_on (sv);	215	SvPADTMP_on (sv);
116	npad[ix] = sv;	216	npad[ix] = sv;
117	}	217	}
118	}	218	}
119		219
120	#if 0 /* NONOTUNDERSTOOD */	220	#if 0 /* return -ENOTUNDERSTOOD */
121	/* Now that vars are all in place, clone nested closures. */	221	/* Now that vars are all in place, clone nested closures. */
122		222
123	for (ix = fpad; ix > 0; ix--) {	223	for (ix = fpad; ix > 0; ix--) {
124	SV* namesv = (ix <= fname) ? pname[ix] : Nullsv;	224	SV* namesv = (ix <= fname) ? pname[ix] : Nullsv;
125	if (namesv	225	if (namesv
…		…
138	#endif	238	#endif
139		239
140	return newpadlist;	240	return newpadlist;
141	}	241	}
142		242
143	STATIC AV *	243	STATIC void
144	free_padlist (AV *padlist)	244	free_padlist (pTHX_ AV *padlist)
145	{	245	{
146	/* may be during global destruction */	246	/* may be during global destruction */
147	if (SvREFCNT(padlist))	247	if (SvREFCNT (padlist))
148	{	248	{
149	I32 i = AvFILLp(padlist);	249	I32 i = AvFILLp (padlist);
150	while (i >= 0)	250	while (i >= 0)
151	{	251	{
152	SV **svp = av_fetch(padlist, i--, FALSE);	252	SV **svp = av_fetch (padlist, i--, FALSE);
153	SV sv = svp ? svp : Nullsv;
154	if (sv)	253	if (svp)
		254	{
		255	SV *sv;
		256	while (&PL_sv_undef != (sv = av_pop ((AV )svp)))
155	SvREFCNT_dec(sv);	257	SvREFCNT_dec (sv);
		258
		259	SvREFCNT_dec (*svp);
		260	}
156	}	261	}
157		262
158	SvREFCNT_dec((SV*)padlist);	263	SvREFCNT_dec ((SV*)padlist);
		264	}
		265	}
		266
		267	STATIC int
		268	coro_cv_free (pTHX_ SV sv, MAGIC mg)
		269	{
		270	AV *padlist;
		271	AV av = (AV )mg->mg_obj;
		272
		273	/* casting is fun. */
		274	while (&PL_sv_undef != (SV )(padlist = (AV )av_pop (av)))
		275	free_padlist (aTHX_ padlist);
		276
		277	SvREFCNT_dec (av);
		278	}
		279
		280	#define PERL_MAGIC_coro PERL_MAGIC_ext
		281
		282	static MGVTBL vtbl_coro = {0, 0, 0, 0, coro_cv_free};
		283
		284	/* the next two functions merely cache the padlists */
		285	STATIC void
		286	get_padlist (pTHX_ CV *cv)
		287	{
		288	MAGIC mg = mg_find ((SV )cv, PERL_MAGIC_coro);
		289
		290	if (mg && AvFILLp ((AV *)mg->mg_obj) >= 0)
		291	CvPADLIST (cv) = (AV )av_pop ((AV )mg->mg_obj);
		292	else
		293	CvPADLIST (cv) = clone_padlist (aTHX_ CvPADLIST (cv));
		294	}
		295
		296	STATIC void
		297	put_padlist (pTHX_ CV *cv)
		298	{
		299	MAGIC mg = mg_find ((SV )cv, PERL_MAGIC_coro);
		300
		301	if (!mg)
		302	{
		303	sv_magic ((SV *)cv, 0, PERL_MAGIC_coro, 0, 0);
		304	mg = mg_find ((SV *)cv, PERL_MAGIC_coro);
		305	mg->mg_virtual = &vtbl_coro;
		306	mg->mg_obj = (SV *)newAV ();
		307	}
		308
		309	av_push ((AV )mg->mg_obj, (SV )CvPADLIST (cv));
		310	}
		311
		312	#define SB do {
		313	#define SE } while (0)
		314
		315	#define LOAD(state) load_state(aTHX_ (state));
		316	#define SAVE(state,flags) save_state(aTHX_ (state),(flags));
		317
		318	#define REPLACE_SV(sv,val) SB SvREFCNT_dec(sv); (sv) = (val); (val) = 0; SE
		319
		320	static void
		321	load_state(pTHX_ Coro__State c)
		322	{
		323	PL_dowarn = c->dowarn;
		324	PL_in_eval = c->in_eval;
		325
		326	PL_curstackinfo = c->curstackinfo;
		327	PL_curstack = c->curstack;
		328	PL_mainstack = c->mainstack;
		329	PL_stack_sp = c->stack_sp;
		330	PL_op = c->op;
		331	PL_curpad = c->curpad;
		332	PL_comppad = c->comppad;
		333	PL_compcv = c->compcv;
		334	PL_stack_base = c->stack_base;
		335	PL_stack_max = c->stack_max;
		336	PL_tmps_stack = c->tmps_stack;
		337	PL_tmps_floor = c->tmps_floor;
		338	PL_tmps_ix = c->tmps_ix;
		339	PL_tmps_max = c->tmps_max;
		340	PL_markstack = c->markstack;
		341	PL_markstack_ptr = c->markstack_ptr;
		342	PL_markstack_max = c->markstack_max;
		343	PL_scopestack = c->scopestack;
		344	PL_scopestack_ix = c->scopestack_ix;
		345	PL_scopestack_max = c->scopestack_max;
		346	PL_savestack = c->savestack;
		347	PL_savestack_ix = c->savestack_ix;
		348	PL_savestack_max = c->savestack_max;
		349	PL_retstack = c->retstack;
		350	PL_retstack_ix = c->retstack_ix;
		351	PL_retstack_max = c->retstack_max;
		352	PL_curcop = c->curcop;
		353	PL_top_env = c->top_env;
		354
		355	if (c->defav) REPLACE_SV (GvAV (PL_defgv), c->defav);
		356	if (c->defsv) REPLACE_SV (DEFSV , c->defsv);
		357	if (c->errsv) REPLACE_SV (ERRSV , c->errsv);
		358
		359	{
		360	dSP;
		361	CV *cv;
		362
		363	/* now do the ugly restore mess */
		364	while ((cv = (CV *)POPs))
		365	{
		366	AV padlist = (AV )POPs;
		367
		368	if (padlist)
		369	{
		370	put_padlist (aTHX_ cv); /* mark this padlist as available */
		371	CvPADLIST(cv) = padlist;
		372	}
		373
		374	++CvDEPTH(cv);
		375	}
		376
		377	PUTBACK;
159	}	378	}
160	}	379	}
161		380
162	/* the next tow functions merely cache the padlists */
163	STATIC void
164	get_padlist (CV *cv)
165	{
166	SV *he = hv_fetch (padlist_cache, (void )&cv, sizeof (CV *), 0);
167
168	if (he && AvFILLp ((AV )he) >= 0)
169	CvPADLIST (cv) = (AV )av_pop ((AV )*he);
170	else
171	CvPADLIST (cv) = clone_padlist (CvPADLIST (cv));
172	}
173
174	STATIC void
175	put_padlist (CV *cv)
176	{
177	SV *he = hv_fetch (padlist_cache, (void )&cv, sizeof (CV *), 1);
178
179	if (SvTYPE (*he) != SVt_PVAV)
180	{
181	SvREFCNT_dec (*he);
182	he = (SV )newAV ();
183	}
184
185	av_push ((AV )he, (SV *)CvPADLIST (cv));
186	}
187
188	static void	381	static void
189	save_state(pTHX_ Coro__State c)	382	save_state(pTHX_ Coro__State c, int flags)
190	{	383	{
191	{	384	{
192	dSP;	385	dSP;
193	I32 cxix = cxstack_ix;	386	I32 cxix = cxstack_ix;
		387	PERL_CONTEXT *ccstk = cxstack;
194	PERL_SI *top_si = PL_curstackinfo;	388	PERL_SI *top_si = PL_curstackinfo;
195	PERL_CONTEXT *ccstk = cxstack;
196		389
197	/*	390	/*
198	* the worst thing you can imagine happens first - we have to save	391	* the worst thing you can imagine happens first - we have to save
199	* (and reinitialize) all cv's in the whole callchain :(	392	* (and reinitialize) all cv's in the whole callchain :(
200	*/	393	*/
…		…
210	if (CxTYPE(cx) == CXt_SUB)	403	if (CxTYPE(cx) == CXt_SUB)
211	{	404	{
212	CV *cv = cx->blk_sub.cv;	405	CV *cv = cx->blk_sub.cv;
213	if (CvDEPTH(cv))	406	if (CvDEPTH(cv))
214	{	407	{
215	#ifdef USE_THREADS
216	XPUSHs ((SV *)CvOWNER(cv));
217	#endif
218	EXTEND (SP, 3);	408	EXTEND (SP, CvDEPTH(cv)*2);
		409
		410	while (--CvDEPTH(cv))
		411	{
		412	/* this tells the restore code to increment CvDEPTH */
		413	PUSHs (Nullsv);
219	PUSHs ((SV *)CvDEPTH(cv));	414	PUSHs ((SV *)cv);
		415	}
		416
220	PUSHs ((SV *)CvPADLIST(cv));	417	PUSHs ((SV *)CvPADLIST(cv));
221	PUSHs ((SV *)cv);	418	PUSHs ((SV *)cv);
222		419
223	get_padlist (cv);	420	get_padlist (aTHX_ cv); /* this is a monster */
224
225	CvDEPTH(cv) = 0;
226	#ifdef USE_THREADS
227	CvOWNER(cv) = 0;
228	error must unlock this cv etc.. etc...
229	if you are here wondering about this error message then
230	the reason is that it will not work as advertised yet
231	#endif
232	}	421	}
233	}	422	}
		423	#ifdef CXt_FORMAT
234	else if (CxTYPE(cx) == CXt_FORMAT)	424	else if (CxTYPE(cx) == CXt_FORMAT)
235	{	425	{
236	/* I never used formats, so how should I know how these are implemented? */	426	/* I never used formats, so how should I know how these are implemented? */
237	/* my bold guess is as a simple, plain sub... */	427	/* my bold guess is as a simple, plain sub... */
238	croak ("CXt_FORMAT not yet handled. Don't switch coroutines from within formats");	428	croak ("CXt_FORMAT not yet handled. Don't switch coroutines from within formats");
239	}	429	}
		430	#endif
240	}	431	}
241		432
242	if (top_si->si_type == PERLSI_MAIN)	433	if (top_si->si_type == PERLSI_MAIN)
243	break;	434	break;
244		435
…		…
248	}	439	}
249		440
250	PUTBACK;	441	PUTBACK;
251	}	442	}
252		443
		444	c->defav = flags & TRANSFER_SAVE_DEFAV ? (AV *)SvREFCNT_inc (GvAV (PL_defgv)) : 0;
		445	c->defsv = flags & TRANSFER_SAVE_DEFSV ? SvREFCNT_inc (DEFSV) : 0;
		446	c->errsv = flags & TRANSFER_SAVE_ERRSV ? SvREFCNT_inc (ERRSV) : 0;
		447
253	c->dowarn = PL_dowarn;	448	c->dowarn = PL_dowarn;
254	c->defav = GvAV (PL_defgv);	449	c->in_eval = PL_in_eval;
		450
255	c->curstackinfo = PL_curstackinfo;	451	c->curstackinfo = PL_curstackinfo;
256	c->curstack = PL_curstack;	452	c->curstack = PL_curstack;
257	c->mainstack = PL_mainstack;	453	c->mainstack = PL_mainstack;
258	c->stack_sp = PL_stack_sp;	454	c->stack_sp = PL_stack_sp;
259	c->op = PL_op;	455	c->op = PL_op;
260	c->curpad = PL_curpad;	456	c->curpad = PL_curpad;
		457	c->comppad = PL_comppad;
		458	c->compcv = PL_compcv;
261	c->stack_base = PL_stack_base;	459	c->stack_base = PL_stack_base;
262	c->stack_max = PL_stack_max;	460	c->stack_max = PL_stack_max;
263	c->tmps_stack = PL_tmps_stack;	461	c->tmps_stack = PL_tmps_stack;
264	c->tmps_floor = PL_tmps_floor;	462	c->tmps_floor = PL_tmps_floor;
265	c->tmps_ix = PL_tmps_ix;	463	c->tmps_ix = PL_tmps_ix;
…		…
275	c->savestack_max = PL_savestack_max;	473	c->savestack_max = PL_savestack_max;
276	c->retstack = PL_retstack;	474	c->retstack = PL_retstack;
277	c->retstack_ix = PL_retstack_ix;	475	c->retstack_ix = PL_retstack_ix;
278	c->retstack_max = PL_retstack_max;	476	c->retstack_max = PL_retstack_max;
279	c->curcop = PL_curcop;	477	c->curcop = PL_curcop;
		478	c->top_env = PL_top_env;
280	}	479	}
281		480
282	#define LOAD(state) do { load_state(aTHX_ state); SPAGAIN; } while (0)	481	/*
283	#define SAVE(state) do { PUTBACK; save_state(aTHX_ state); } while (0)	482	* allocate various perl stacks. This is an exact copy
284		483	* of perl.c:init_stacks, except that it uses less memory
285	static void	484	* on the (sometimes correct) assumption that coroutines do
286	load_state(pTHX_ Coro__State c)	485	* not usually need a lot of stackspace.
		486	*/
		487	STATIC void
		488	coro_init_stacks (pTHX)
287	{	489	{
288	PL_dowarn = c->dowarn;	490	LOCK;
289	GvAV (PL_defgv) = c->defav;	491
290	PL_curstackinfo = c->curstackinfo;	492	PL_curstackinfo = new_stackinfo(96, 1024/sizeof(PERL_CONTEXT) - 1);
291	PL_curstack = c->curstack;	493	PL_curstackinfo->si_type = PERLSI_MAIN;
292	PL_mainstack = c->mainstack;	494	PL_curstack = PL_curstackinfo->si_stack;
		495	PL_mainstack = PL_curstack; /* remember in case we switch stacks */
		496
		497	PL_stack_base = AvARRAY(PL_curstack);
293	PL_stack_sp = c->stack_sp;	498	PL_stack_sp = PL_stack_base;
294	PL_op = c->op;	499	PL_stack_max = PL_stack_base + AvMAX(PL_curstack);
295	PL_curpad = c->curpad;	500
296	PL_stack_base = c->stack_base;	501	New(50,PL_tmps_stack,96,SV*);
297	PL_stack_max = c->stack_max;	502	PL_tmps_floor = -1;
298	PL_tmps_stack = c->tmps_stack;	503	PL_tmps_ix = -1;
299	PL_tmps_floor = c->tmps_floor;	504	PL_tmps_max = 96;
300	PL_tmps_ix = c->tmps_ix;	505
301	PL_tmps_max = c->tmps_max;	506	New(54,PL_markstack,16,I32);
302	PL_markstack = c->markstack;
303	PL_markstack_ptr = c->markstack_ptr;	507	PL_markstack_ptr = PL_markstack;
304	PL_markstack_max = c->markstack_max;	508	PL_markstack_max = PL_markstack + 16;
305	PL_scopestack = c->scopestack;
306	PL_scopestack_ix = c->scopestack_ix;
307	PL_scopestack_max = c->scopestack_max;
308	PL_savestack = c->savestack;
309	PL_savestack_ix = c->savestack_ix;
310	PL_savestack_max = c->savestack_max;
311	PL_retstack = c->retstack;
312	PL_retstack_ix = c->retstack_ix;
313	PL_retstack_max = c->retstack_max;
314	PL_curcop = c->curcop;
315		509
316	{	510	#ifdef SET_MARK_OFFSET
317	dSP;	511	SET_MARK_OFFSET;
318	CV *cv;
319
320	/* now do the ugly restore mess */
321	while ((cv = (CV *)POPs))
322	{
323	AV padlist = (AV )POPs;
324
325	put_padlist (cv);
326	CvPADLIST(cv) = padlist;
327	CvDEPTH(cv) = (I32)POPs;
328
329	#ifdef USE_THREADS
330	CvOWNER(cv) = (struct perl_thread *)POPs;
331	error does not work either
332	#endif	512	#endif
333	}
334		513
335	PUTBACK;	514	New(54,PL_scopestack,16,I32);
336	}	515	PL_scopestack_ix = 0;
337	}	516	PL_scopestack_max = 16;
338		517
339	/* this is an EXACT copy of S_nuke_stacks in perl.c, which is unfortunately static */	518	New(54,PL_savestack,96,ANY);
		519	PL_savestack_ix = 0;
		520	PL_savestack_max = 96;
		521
		522	New(54,PL_retstack,8,OP*);
		523	PL_retstack_ix = 0;
		524	PL_retstack_max = 8;
		525
		526	UNLOCK;
		527	}
		528
		529	/*
		530	* destroy the stacks, the callchain etc...
		531	*/
340	STATIC void	532	STATIC void
341	destroy_stacks(pTHX)	533	destroy_stacks(pTHX)
342	{	534	{
343	/* die does this while calling POPSTACK, but I just don't see why. */	535	if (!IN_DESTRUCT)
344	/* OTOH, die does not have a memleak, but we do... */	536	{
345	dounwind(-1);
346
347	/* is this ugly, I ask? */	537	/* is this ugly, I ask? */
348	while (PL_scopestack_ix)	538	LEAVE_SCOPE (0);
349	LEAVE;	539
		540	/* sure it is, but more important: is it correct?? :/ */
		541	FREETMPS;
		542
		543	/POPSTACK_TO (PL_mainstack);//D//use/
		544	}
350		545
351	while (PL_curstackinfo->si_next)	546	while (PL_curstackinfo->si_next)
352	PL_curstackinfo = PL_curstackinfo->si_next;	547	PL_curstackinfo = PL_curstackinfo->si_next;
353		548
354	while (PL_curstackinfo)	549	while (PL_curstackinfo)
355	{	550	{
356	PERL_SI *p = PL_curstackinfo->si_prev;	551	PERL_SI *p = PL_curstackinfo->si_prev;
357		552
		553	{ /D//remove/
		554	dSP;
		555	SWITCHSTACK (PL_curstack, PL_curstackinfo->si_stack);
		556	PUTBACK; /* possibly superfluous */
		557	}
		558
		559	if (!IN_DESTRUCT)
		560	{
		561	dounwind (-1);/D//remove/
358	SvREFCNT_dec(PL_curstackinfo->si_stack);	562	SvREFCNT_dec (PL_curstackinfo->si_stack);
		563	}
		564
359	Safefree(PL_curstackinfo->si_cxstack);	565	Safefree (PL_curstackinfo->si_cxstack);
360	Safefree(PL_curstackinfo);	566	Safefree (PL_curstackinfo);
361	PL_curstackinfo = p;	567	PL_curstackinfo = p;
362	}	568	}
363		569
364	if (PL_scopestack_ix != 0)	570	Safefree (PL_tmps_stack);
365	Perl_warner(aTHX_ WARN_INTERNAL,	571	Safefree (PL_markstack);
366	"Unbalanced scopes: %ld more ENTERs than LEAVEs\n",	572	Safefree (PL_scopestack);
367	(long)PL_scopestack_ix);	573	Safefree (PL_savestack);
368	if (PL_savestack_ix != 0)	574	Safefree (PL_retstack);
369	Perl_warner(aTHX_ WARN_INTERNAL,	575	}
370	"Unbalanced saves: %ld more saves than restores\n",	576
371	(long)PL_savestack_ix);	577	static void
372	if (PL_tmps_floor != -1)	578	allocate_stack (Coro__State ctx, int alloc)
373	Perl_warner(aTHX_ WARN_INTERNAL,"Unbalanced tmps: %ld more allocs than frees\n",	579	{
374	(long)PL_tmps_floor + 1);	580	coro_stack *stack;
		581
		582	New (0, stack, 1, coro_stack);
		583
		584	stack->refcnt = 1;
		585	stack->usecnt = 1;
		586	stack->gencnt = ctx->gencnt = 0;
		587
		588	if (alloc)
		589	{
		590	#if HAVE_MMAP
		591	stack->ssize = 16384 * sizeof (long); /* mmap should do allocate-on-write for us */
		592	stack->sptr = mmap (0, stack->ssize, PROT_EXEC\|PROT_READ\|PROT_WRITE, MAP_PRIVATE\|MAP_ANONYMOUS, 0, 0);
		593	if (stack->sptr == (void *)-1)
		594	#endif
		595	{
		596	/FIXME//D//* reasonable stack size! */
		597	stack->ssize = - (8192 * sizeof (long));
		598	New (0, stack->sptr, 8192, long);
		599	}
		600	}
		601	else
		602	stack->sptr = 0;
		603
		604	ctx->stack = stack;
		605	}
		606
		607	static void
		608	deallocate_stack (Coro__State ctx)
		609	{
		610	coro_stack *stack = ctx->stack;
		611
		612	ctx->stack = 0;
		613
		614	if (stack)
		615	{
		616	if (!--stack->refcnt)
		617	{
		618	#ifdef HAVE_MMAP
		619	if (stack->ssize > 0 && stack->sptr)
		620	munmap (stack->sptr, stack->ssize);
		621	else
		622	#endif
		623	Safefree (stack->sptr);
		624
		625	Safefree (stack);
		626	}
		627	else if (ctx->gencnt == stack->gencnt)
		628	--stack->usecnt;
		629	}
		630	}
		631
		632	static void
		633	setup_coro (void *arg)
		634	{
375	/*	635	/*
		636	* emulate part of the perl startup here.
		637	*/
		638	dTHX;
		639	dSP;
		640	Coro__State ctx = (Coro__State)arg;
		641	SV sub_init = (SV )get_cv (SUB_INIT, FALSE);
		642
		643	coro_init_stacks (aTHX);
		644	/PL_curcop = 0;/
		645	/PL_in_eval = PL_in_eval;/ /* inherit */
		646	SvREFCNT_dec (GvAV (PL_defgv));
		647	GvAV (PL_defgv) = ctx->args; ctx->args = 0;
		648
		649	SPAGAIN;
		650
		651	if (ctx->stack)
		652	{
		653	ctx->cursp = 0;
		654
		655	PUSHMARK(SP);
		656	PUTBACK;
		657	(void) call_sv (sub_init, G_VOID\|G_NOARGS\|G_EVAL);
		658
		659	if (SvTRUE (ERRSV))
		660	croak (NULL);
		661	else
		662	croak ("FATAL: CCTXT coroutine returned!");
		663	}
		664	else
		665	{
		666	UNOP myop;
		667
		668	PL_op = (OP *)&myop;
		669
		670	Zero(&myop, 1, UNOP);
		671	myop.op_next = Nullop;
		672	myop.op_flags = OPf_WANT_VOID;
		673
		674	PUSHMARK(SP);
		675	XPUSHs (sub_init);
		676	/*
		677	* the next line is slightly wrong, as PL_op->op_next
		678	* is actually being executed so we skip the first op.
		679	* that doesn't matter, though, since it is only
		680	* pp_nextstate and we never return...
		681	* ah yes, and I don't care anyways ;)
		682	*/
		683	PUTBACK;
		684	PL_op = PL_ppaddr[OP_ENTERSUB](aTHX);
		685	SPAGAIN;
		686
		687	ENTER; /* necessary e.g. for dounwind */
		688	}
		689	}
		690
		691	static void
		692	continue_coro (void *arg)
		693	{
		694	/*
		695	* this is a _very_ stripped down perl interpreter ;)
		696	*/
		697	dTHX;
		698	Coro__State ctx = (Coro__State)arg;
		699	JMPENV coro_start_env;
		700
		701	PL_top_env = &ctx->start_env;
		702
		703	ctx->cursp = 0;
		704	PL_op = PL_op->op_next;
		705	CALLRUNOPS(aTHX);
		706
		707	abort ();
		708	}
		709
		710	STATIC void
		711	transfer (pTHX_ struct coro prev, struct coro next, int flags)
		712	{
		713	dSTACKLEVEL;
		714
		715	if (prev != next)
		716	{
		717	if (next->mainstack)
		718	{
		719	LOCK;
		720	SAVE (prev, flags);
		721	LOAD (next);
		722	UNLOCK;
		723
		724	/* mark this state as in-use */
		725	next->mainstack = 0;
		726	next->tmps_ix = -2;
		727
		728	/* stacklevel changed? if yes, grab the stack for us! */
		729	if (flags & TRANSFER_SAVE_CCTXT)
		730	{
		731	if (!prev->stack)
		732	allocate_stack (prev, 0);
		733	else if (prev->cursp != stacklevel
		734	&& prev->stack->usecnt > 1)
376	*/	735	{
377	Safefree(PL_tmps_stack);	736	prev->gencnt = ++prev->stack->gencnt;
378	Safefree(PL_markstack);	737	prev->stack->usecnt = 1;
379	Safefree(PL_scopestack);	738	}
380	Safefree(PL_savestack);
381	Safefree(PL_retstack);
382	}
383		739
384	#define SUB_INIT "Coro::State::_newcoro"	740	/* has our stack been invalidated? */
		741	if (next->stack && next->stack->gencnt != next->gencnt)
		742	{
		743	deallocate_stack (next);
		744	allocate_stack (next, 1);
		745	coro_create (&(next->stack->cctx),
		746	continue_coro, (void *)next,
		747	next->stack->sptr, labs (next->stack->ssize));
		748	}
		749
		750	coro_transfer (&(prev->stack->cctx), &(next->stack->cctx));
		751	prev->cursp = stacklevel;
		752	/* don't add any code here */
		753	}
		754	else
		755	next->cursp = stacklevel;
		756	}
		757	else if (next->tmps_ix == -2)
		758	croak ("tried to transfer to running coroutine");
		759	else
		760	{
		761	LOCK;
		762	SAVE (prev, -1); /* first get rid of the old state */
		763	UNLOCK;
		764
		765	if (flags & TRANSFER_SAVE_CCTXT)
		766	{
		767	if (!prev->stack)
		768	allocate_stack (prev, 0);
		769
		770	if (prev->stack->sptr && flags & TRANSFER_LAZY_STACK)
		771	{
		772	PL_top_env = &next->start_env;
		773
		774	setup_coro (next);
		775	next->cursp = stacklevel;
		776
		777	prev->stack->refcnt++;
		778	prev->stack->usecnt++;
		779	next->stack = prev->stack;
		780	next->gencnt = prev->gencnt;
		781	}
		782	else
		783	{
		784	assert (!next->stack);
		785	allocate_stack (next, 1);
		786	coro_create (&(next->stack->cctx),
		787	setup_coro, (void *)next,
		788	next->stack->sptr, labs (next->stack->ssize));
		789	coro_transfer (&(prev->stack->cctx), &(next->stack->cctx));
		790	prev->cursp = stacklevel;
		791	/* don't add any code here */
		792	}
		793	}
		794	else
		795	{
		796	setup_coro (next);
		797	next->cursp = stacklevel;
		798	}
		799	}
		800	}
		801
		802	LOCK;
		803	if (coro_mortal)
		804	{
		805	SvREFCNT_dec (coro_mortal);
		806	coro_mortal = 0;
		807	}
		808	UNLOCK;
		809	}
		810
		811	#define SV_CORO(sv,func) \
		812	do { \
		813	if (SvROK (sv)) \
		814	sv = SvRV (sv); \
		815	\
		816	if (SvTYPE (sv) == SVt_PVHV) \
		817	{ \
		818	HE he = hv_fetch_ent ((HV )sv, ucoro_state_sv, 0, ucoro_state_hash); \
		819	\
		820	if (!he) \
		821	croak ("%s() -- %s is a hashref but lacks the " UCORO_STATE " key", func, # sv); \
		822	\
		823	(sv) = SvRV (HeVAL(he)); \
		824	} \
		825	\
		826	/* must also be changed inside Coro::Cont::yield */ \
		827	if (!SvOBJECT (sv) \|\| SvSTASH (sv) != coro_state_stash) \
		828	croak ("%s() -- %s is not (and contains not) a Coro::State object", func, # sv); \
		829	\
		830	} while(0)
		831
		832	#define SvSTATE(sv) (struct coro *)SvIV (sv)
		833
		834	static void
		835	api_transfer(pTHX_ SV prev, SV next, int flags)
		836	{
		837	SV_CORO (prev, "Coro::transfer");
		838	SV_CORO (next, "Coro::transfer");
		839
		840	transfer (aTHX_ SvSTATE (prev), SvSTATE (next), flags);
		841	}
		842
		843	/ Coro ******************************************************************/
		844
		845	#define PRIO_MAX 3
		846	#define PRIO_HIGH 1
		847	#define PRIO_NORMAL 0
		848	#define PRIO_LOW -1
		849	#define PRIO_IDLE -3
		850	#define PRIO_MIN -4
		851
		852	/* for Coro.pm */
		853	static GV coro_current, coro_idle;
		854	static AV *coro_ready[PRIO_MAX-PRIO_MIN+1];
		855	static int coro_nready;
		856
		857	static void
		858	coro_enq (pTHX_ SV *sv)
		859	{
		860	if (SvTYPE (sv) == SVt_PVHV)
		861	{
		862	SV *xprio = hv_fetch ((HV )sv, "prio", 4, 0);
		863	int prio = xprio ? SvIV (*xprio) : PRIO_NORMAL;
		864
		865	prio = prio > PRIO_MAX ? PRIO_MAX
		866	: prio < PRIO_MIN ? PRIO_MIN
		867	: prio;
		868
		869	av_push (coro_ready [prio - PRIO_MIN], sv);
		870	coro_nready++;
		871
		872	return;
		873	}
		874
		875	croak ("Coro::ready tried to enqueue something that is not a coroutine");
		876	}
		877
		878	static SV *
		879	coro_deq (pTHX_ int min_prio)
		880	{
		881	int prio = PRIO_MAX - PRIO_MIN;
		882
		883	min_prio -= PRIO_MIN;
		884	if (min_prio < 0)
		885	min_prio = 0;
		886
		887	for (prio = PRIO_MAX - PRIO_MIN + 1; --prio >= min_prio; )
		888	if (av_len (coro_ready[prio]) >= 0)
		889	{
		890	coro_nready--;
		891	return av_shift (coro_ready[prio]);
		892	}
		893
		894	return 0;
		895	}
		896
		897	static void
		898	api_ready (SV *coro)
		899	{
		900	dTHX;
		901
		902	if (SvROK (coro))
		903	coro = SvRV (coro);
		904
		905	LOCK;
		906	coro_enq (aTHX_ SvREFCNT_inc (coro));
		907	UNLOCK;
		908	}
		909
		910	static void
		911	api_schedule (void)
		912	{
		913	dTHX;
		914
		915	SV prev, next;
		916
		917	LOCK;
		918
		919	prev = SvRV (GvSV (coro_current));
		920	next = coro_deq (aTHX_ PRIO_MIN);
		921
		922	if (!next)
		923	next = SvREFCNT_inc (SvRV (GvSV (coro_idle)));
		924
		925	/* free this only after the transfer */
		926	coro_mortal = prev;
		927	SV_CORO (prev, "Coro::schedule");
		928
		929	SvRV (GvSV (coro_current)) = next;
		930
		931	SV_CORO (next, "Coro::schedule");
		932
		933	UNLOCK;
		934
		935	transfer (aTHX_ SvSTATE (prev), SvSTATE (next),
		936	TRANSFER_SAVE_ALL \| TRANSFER_LAZY_STACK);
		937	}
		938
		939	static void
		940	api_cede (void)
		941	{
		942	dTHX;
		943
		944	LOCK;
		945	coro_enq (aTHX_ SvREFCNT_inc (SvRV (GvSV (coro_current))));
		946	UNLOCK;
		947
		948	api_schedule ();
		949	}
385		950
386	MODULE = Coro::State PACKAGE = Coro::State	951	MODULE = Coro::State PACKAGE = Coro::State
387		952
388	PROTOTYPES: ENABLE	953	PROTOTYPES: ENABLE
389		954
390	BOOT:	955	BOOT:
391	if (!padlist_cache)	956	{ /* {} necessary for stoopid perl-5.6.x */
392	padlist_cache = newHV ();	957	#ifdef USE_ITHREADS
		958	MUTEX_INIT (&coro_mutex);
		959	#endif
		960
		961	ucoro_state_sv = newSVpv (UCORO_STATE, sizeof(UCORO_STATE) - 1);
		962	PERL_HASH(ucoro_state_hash, UCORO_STATE, sizeof(UCORO_STATE) - 1);
		963	coro_state_stash = gv_stashpv ("Coro::State", TRUE);
		964
		965	newCONSTSUB (coro_state_stash, "SAVE_DEFAV", newSViv (TRANSFER_SAVE_DEFAV));
		966	newCONSTSUB (coro_state_stash, "SAVE_DEFSV", newSViv (TRANSFER_SAVE_DEFSV));
		967	newCONSTSUB (coro_state_stash, "SAVE_ERRSV", newSViv (TRANSFER_SAVE_ERRSV));
		968	newCONSTSUB (coro_state_stash, "SAVE_CCTXT", newSViv (TRANSFER_SAVE_CCTXT));
		969
		970	main_mainstack = PL_mainstack;
		971
		972	coroapi.ver = CORO_API_VERSION;
		973	coroapi.transfer = api_transfer;
		974	}
393		975
394	Coro::State	976	Coro::State
395	_newprocess(args)	977	_newprocess(args)
396	SV * args	978	SV * args
397	PROTOTYPE: $	979	PROTOTYPE: $
398	CODE:	980	CODE:
399	Coro__State coro;	981	Coro__State coro;
400		982
401	if (!SvROK (args) \|\| SvTYPE (SvRV (args)) != SVt_PVAV)	983	if (!SvROK (args) \|\| SvTYPE (SvRV (args)) != SVt_PVAV)
402	croak ("Coro::State::newprocess expects an arrayref");	984	croak ("Coro::State::_newprocess expects an arrayref");
403		985
404	New (0, coro, 1, struct coro);	986	Newz (0, coro, 1, struct coro);
405		987
406	coro->mainstack = 0; /* actual work is done inside transfer */
407	coro->args = (AV *)SvREFCNT_inc (SvRV (args));	988	coro->args = (AV *)SvREFCNT_inc (SvRV (args));
		989	/coro->mainstack = 0; //actual work is done inside transfer /
		990	/coro->stack = 0;/
		991
		992	/* same as JMPENV_BOOTSTRAP */
		993	/* we might be able to recycle start_env, but safe is safe */
		994	/Zero(&coro->start_env, 1, JMPENV);/
		995	coro->start_env.je_ret = -1;
		996	coro->start_env.je_mustcatch = TRUE;
408		997
409	RETVAL = coro;	998	RETVAL = coro;
410	OUTPUT:	999	OUTPUT:
411	RETVAL	1000	RETVAL
412		1001
413	void	1002	void
414	transfer(prev,next)	1003	transfer(prev, next, flags)
415	Coro::State_or_hashref prev	1004	SV *prev
416	Coro::State_or_hashref next	1005	SV *next
		1006	int flags
		1007	PROTOTYPE: @
417	CODE:	1008	CODE:
418
419	if (prev != next)
420	{
421	/*
422	* this could be done in newprocess which would lead to
423	* extremely elegant and fast (just SAVE/LOAD)
424	* code here, but lazy allocation of stacks has also
425	* some virtues and the overhead of the if() is nil.
426	*/
427	if (next->mainstack)
428	{
429	SAVE (prev);
430	LOAD (next);
431	/* mark this state as in-use */
432	next->mainstack = 0;
433	next->tmps_ix = -2;
434	}
435	else if (next->tmps_ix == -2)
436	{
437	croak ("tried to transfer to running coroutine");
438	}
439	else
440	{
441	SAVE (prev);
442
443	/*
444	* emulate part of the perl startup here.
445	*/
446	UNOP myop;
447
448	init_stacks (); /* from perl.c */
449	PL_op = (OP *)&myop;
450	/PL_curcop = 0;/
451	GvAV (PL_defgv) = (AV )SvREFCNT_inc ((SV )next->args);
452
453	SPAGAIN;
454	Zero(&myop, 1, UNOP);
455	myop.op_next = Nullop;
456	myop.op_flags = OPf_WANT_VOID;
457
458	PUSHMARK(SP);
459	XPUSHs ((SV*)get_cv(SUB_INIT, TRUE));
460	PUTBACK;	1009	PUTBACK;
461	/*	1010	SV_CORO (next, "Coro::transfer");
462	* the next line is slightly wrong, as PL_op->op_next	1011	SV_CORO (prev, "Coro::transfer");
463	* is actually being executed so we skip the first op.	1012	transfer (aTHX_ SvSTATE (prev), SvSTATE (next), flags);
464	* that doesn't matter, though, since it is only
465	* pp_nextstate and we never return...
466	*/
467	PL_op = Perl_pp_entersub(aTHX);
468	SPAGAIN;	1013	SPAGAIN;
469
470	ENTER;
471	}
472	}
473		1014
474	void	1015	void
475	DESTROY(coro)	1016	DESTROY(coro)
476	Coro::State coro	1017	Coro::State coro
477	CODE:	1018	CODE:
478		1019
479	if (coro->mainstack)	1020	if (coro->mainstack && coro->mainstack != main_mainstack)
480	{	1021	{
481	struct coro temp;	1022	struct coro temp;
482		1023
		1024	PUTBACK;
483	SAVE(aTHX_ (&temp));	1025	SAVE (aTHX_ (&temp), TRANSFER_SAVE_ALL);
484	LOAD(aTHX_ coro);	1026	LOAD (aTHX_ coro);
		1027	SPAGAIN;
485		1028
486	destroy_stacks ();	1029	destroy_stacks (aTHX);
487	SvREFCNT_dec ((SV *)GvAV (PL_defgv));
488		1030
489	LOAD((&temp));	1031	LOAD ((&temp)); /* this will get rid of defsv etc.. */
		1032	SPAGAIN;
		1033
		1034	coro->mainstack = 0;
490	}	1035	}
491		1036
		1037	deallocate_stack (coro);
492	SvREFCNT_dec (coro->args);	1038	SvREFCNT_dec (coro->args);
493	Safefree (coro);	1039	Safefree (coro);
494		1040
		1041	void
		1042	_exit(code)
		1043	int code
		1044	PROTOTYPE: $
		1045	CODE:
		1046	_exit (code);
495		1047
		1048	MODULE = Coro::State PACKAGE = Coro::Cont
		1049
		1050	# this is slightly dirty (should expose a c-level api)
		1051
		1052	void
		1053	yield(...)
		1054	PROTOTYPE: @
		1055	CODE:
		1056	static SV *returnstk;
		1057	SV *sv;
		1058	AV *defav = GvAV (PL_defgv);
		1059	struct coro prev, next;
		1060
		1061	if (!returnstk)
		1062	returnstk = SvRV ((SV *)get_sv ("Coro::Cont::return", FALSE));
		1063
		1064	/* set up @_ -- ugly */
		1065	av_clear (defav);
		1066	av_fill (defav, items - 1);
		1067	while (items--)
		1068	av_store (defav, items, SvREFCNT_inc (ST(items)));
		1069
		1070	SvGETMAGIC (returnstk); /* isn't documentation wrong for mg_get? */
		1071	sv = av_pop ((AV *)SvRV (returnstk));
		1072	prev = (struct coro )SvIV ((SV)SvRV (av_fetch ((AV )SvRV (sv), 0, 0)));
		1073	next = (struct coro )SvIV ((SV)SvRV (av_fetch ((AV )SvRV (sv), 1, 0)));
		1074	SvREFCNT_dec (sv);
		1075
		1076	transfer (aTHX_ prev, next, 0);
		1077
		1078	MODULE = Coro::State PACKAGE = Coro
		1079
		1080	# this is slightly dirty (should expose a c-level api)
		1081
		1082	BOOT:
		1083	{
		1084	int i;
		1085	HV *stash = gv_stashpv ("Coro", TRUE);
		1086
		1087	newCONSTSUB (stash, "PRIO_MAX", newSViv (PRIO_MAX));
		1088	newCONSTSUB (stash, "PRIO_HIGH", newSViv (PRIO_HIGH));
		1089	newCONSTSUB (stash, "PRIO_NORMAL", newSViv (PRIO_NORMAL));
		1090	newCONSTSUB (stash, "PRIO_LOW", newSViv (PRIO_LOW));
		1091	newCONSTSUB (stash, "PRIO_IDLE", newSViv (PRIO_IDLE));
		1092	newCONSTSUB (stash, "PRIO_MIN", newSViv (PRIO_MIN));
		1093
		1094	coro_current = gv_fetchpv ("Coro::current", TRUE, SVt_PV);
		1095	coro_idle = gv_fetchpv ("Coro::idle" , TRUE, SVt_PV);
		1096
		1097	for (i = PRIO_MAX - PRIO_MIN + 1; i--; )
		1098	coro_ready[i] = newAV ();
		1099
		1100	{
		1101	SV *sv = perl_get_sv("Coro::API", 1);
		1102
		1103	coroapi.schedule = api_schedule;
		1104	coroapi.cede = api_cede;
		1105	coroapi.ready = api_ready;
		1106	coroapi.nready = &coro_nready;
		1107	coroapi.current = coro_current;
		1108
		1109	GCoroAPI = &coroapi;
		1110	sv_setiv(sv, (IV)&coroapi);
		1111	SvREADONLY_on(sv);
		1112	}
		1113	}
		1114
		1115	#if !PERL_MICRO
		1116
		1117	void
		1118	ready(self)
		1119	SV * self
		1120	PROTOTYPE: $
		1121	CODE:
		1122	api_ready (self);
		1123
		1124	#endif
		1125
		1126	int
		1127	nready(...)
		1128	PROTOTYPE:
		1129	CODE:
		1130	RETVAL = coro_nready;
		1131	OUTPUT:
		1132	RETVAL
		1133
		1134	void
		1135	schedule(...)
		1136	PROTOTYPE:
		1137	CODE:
		1138	api_schedule ();
		1139
		1140	void
		1141	cede(...)
		1142	PROTOTYPE:
		1143	CODE:
		1144	api_cede ();
		1145

Diff Legend

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

Comparing Coro/Coro/State.xs (file contents): Revision 1.6 by root, Tue Jul 17 15:42:28 2001 UTC vs. Revision 1.63 by root, Mon Mar 21 14:35:22 2005 UTC

Diff Legend

Comparing Coro/Coro/State.xs (file contents):
Revision 1.6 by root, Tue Jul 17 15:42:28 2001 UTC vs.
Revision 1.63 by root, Mon Mar 21 14:35:22 2005 UTC