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

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.83 by root, Mon Nov 20 22:32:44 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.83 by root, Mon Nov 20 22:32:44 2006 UTC