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

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

Diff Legend

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

Comparing Coro/Coro/State.xs (file contents): Revision 1.3 by root, Tue Jul 17 00:24:15 2001 UTC vs. Revision 1.77 by root, Tue Oct 31 23:55:33 2006 UTC

Diff Legend

Comparing Coro/Coro/State.xs (file contents):
Revision 1.3 by root, Tue Jul 17 00:24:15 2001 UTC vs.
Revision 1.77 by root, Tue Oct 31 23:55:33 2006 UTC