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

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.75 by root, Thu Oct 26 06:50:20 2006 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.75 by root, Thu Oct 26 06:50:20 2006 UTC