ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/Coro/Coro/State.xs
(Generate patch)

Comparing Coro/Coro/State.xs (file contents):
Revision 1.5 by root, Tue Jul 17 02:55:29 2001 UTC vs.
Revision 1.175 by root, Sun Sep 30 13:43:45 2007 UTC

1#include "libcoro/coro.c"
2
3#define PERL_NO_GET_CONTEXT
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#include <stdio.h>
12#include <errno.h>
13#include <assert.h>
14
15#ifdef HAVE_MMAP
16# include <unistd.h>
17# include <sys/mman.h>
18# ifndef MAP_ANONYMOUS
19# ifdef MAP_ANON
20# define MAP_ANONYMOUS MAP_ANON
21# else
22# undef HAVE_MMAP
23# endif
24# endif
25# include <limits.h>
26# ifndef PAGESIZE
27# define PAGESIZE pagesize
28# define BOOT_PAGESIZE pagesize = sysconf (_SC_PAGESIZE)
29static long pagesize;
30# else
31# define BOOT_PAGESIZE (void)0
32# endif
7#else 33#else
8# define CHK(x) if (!(x)) croak("FATAL, CHK: " #x) 34# define PAGESIZE 0
35# define BOOT_PAGESIZE (void)0
36#endif
37
38#if CORO_USE_VALGRIND
39# include <valgrind/valgrind.h>
40# define REGISTER_STACK(cctx,start,end) (cctx)->valgrind_id = VALGRIND_STACK_REGISTER ((start), (end))
41#else
42# define REGISTER_STACK(cctx,start,end)
43#endif
44
45/* the maximum number of idle cctx that will be pooled */
46#define MAX_IDLE_CCTX 8
47
48#define PERL_VERSION_ATLEAST(a,b,c) \
49 (PERL_REVISION > (a) \
50 || (PERL_REVISION == (a) \
51 && (PERL_VERSION > (b) \
52 || (PERL_VERSION == (b) && PERLSUBVERSION >= (c)))))
53
54#if !PERL_VERSION_ATLEAST (5,6,0)
55# ifndef PL_ppaddr
56# define PL_ppaddr ppaddr
9#endif 57# endif
58# ifndef call_sv
59# define call_sv perl_call_sv
60# endif
61# ifndef get_sv
62# define get_sv perl_get_sv
63# endif
64# ifndef get_cv
65# define get_cv perl_get_cv
66# endif
67# ifndef IS_PADGV
68# define IS_PADGV(v) 0
69# endif
70# ifndef IS_PADCONST
71# define IS_PADCONST(v) 0
72# endif
73#endif
10 74
75/* 5.8.7 */
76#ifndef SvRV_set
77# define SvRV_set(s,v) SvRV(s) = (v)
78#endif
79
80#if !__i386 && !__x86_64 && !__powerpc && !__m68k && !__alpha && !__mips && !__sparc64
81# undef CORO_STACKGUARD
82#endif
83
84#ifndef CORO_STACKGUARD
85# define CORO_STACKGUARD 0
86#endif
87
88/* prefer perl internal functions over our own? */
89#ifndef CORO_PREFER_PERL_FUNCTIONS
90# define CORO_PREFER_PERL_FUNCTIONS 0
91#endif
92
93/* The next macros try to return the current stack pointer, in an as
94 * portable way as possible. */
95#define dSTACKLEVEL volatile char stacklevel
96#define STACKLEVEL ((void *)&stacklevel)
97
98#define IN_DESTRUCT (PL_main_cv == Nullcv)
99
100#if __GNUC__ >= 3
101# define attribute(x) __attribute__(x)
102# define BARRIER __asm__ __volatile__ ("" : : : "memory")
103#else
104# define attribute(x)
105# define BARRIER
106#endif
107
108#define NOINLINE attribute ((noinline))
109
110#include "CoroAPI.h"
111
112#ifdef USE_ITHREADS
113static perl_mutex coro_mutex;
114# define LOCK do { MUTEX_LOCK (&coro_mutex); } while (0)
115# define UNLOCK do { MUTEX_UNLOCK (&coro_mutex); } while (0)
116#else
117# define LOCK (void)0
118# define UNLOCK (void)0
119#endif
120
121/* helper storage struct for Coro::AIO */
122struct io_state
123{
124 int errorno;
125 I32 laststype;
126 int laststatval;
127 Stat_t statcache;
128};
129
130static size_t coro_stacksize = CORO_STACKSIZE;
131static struct CoroAPI coroapi;
132static AV *main_mainstack; /* used to differentiate between $main and others */
133static JMPENV *main_top_env;
134static HV *coro_state_stash, *coro_stash;
135static SV *coro_mortal; /* will be freed after next transfer */
136
137/* async_pool helper stuff */
138static SV *sv_pool_rss;
139static SV *sv_pool_size;
140static AV *av_async_pool;
141
142static struct coro_cctx *cctx_first;
143static int cctx_count, cctx_idle;
144
145enum {
146 CC_MAPPED = 0x01,
147 CC_NOREUSE = 0x02, /* throw this away after tracing */
148 CC_TRACE = 0x04,
149 CC_TRACE_SUB = 0x08, /* trace sub calls */
150 CC_TRACE_LINE = 0x10, /* trace each statement */
151 CC_TRACE_ALL = CC_TRACE_SUB | CC_TRACE_LINE,
152};
153
154/* this is a structure representing a c-level coroutine */
155typedef struct coro_cctx {
156 struct coro_cctx *next;
157
158 /* the stack */
159 void *sptr;
160 size_t ssize;
161
162 /* cpu state */
163 void *idle_sp; /* sp of top-level transfer/schedule/cede call */
164 JMPENV *idle_te; /* same as idle_sp, but for top_env, TODO: remove once stable */
165 JMPENV *top_env;
166 coro_context cctx;
167
168#if CORO_USE_VALGRIND
169 int valgrind_id;
170#endif
171 unsigned char flags;
172} coro_cctx;
173
174enum {
175 CF_RUNNING = 0x0001, /* coroutine is running */
176 CF_READY = 0x0002, /* coroutine is ready */
177 CF_NEW = 0x0004, /* has never been switched to */
178 CF_DESTROYED = 0x0008, /* coroutine data has been freed */
179};
180
181/* this is a structure representing a perl-level coroutine */
11struct coro { 182struct coro {
12 U8 dowarn; 183 /* the c coroutine allocated to this perl coroutine, if any */
13 AV *defav; 184 coro_cctx *cctx;
185
186 /* data associated with this coroutine (initial args) */
187 AV *args;
188 int refcnt;
189 int save; /* CORO_SAVE flags */
190 int flags; /* CF_ flags */
191
192 /* optionally saved, might be zero */
193 AV *defav; /* @_ */
194 SV *defsv; /* $_ */
195 SV *errsv; /* $@ */
196 GV *deffh; /* default filehandle */
197 SV *irssv; /* $/ */
198 SV *irssv_sv; /* real $/ cache */
14 199
15 PERL_SI *curstackinfo; 200#define VAR(name,type) type name;
16 AV *curstack; 201# include "state.h"
17 AV *mainstack; 202#undef VAR
18 SV **stack_sp;
19 OP *op;
20 SV **curpad;
21 SV **stack_base;
22 SV **stack_max;
23 SV **tmps_stack;
24 I32 tmps_floor;
25 I32 tmps_ix;
26 I32 tmps_max;
27 I32 *markstack;
28 I32 *markstack_ptr;
29 I32 *markstack_max;
30 I32 *scopestack;
31 I32 scopestack_ix;
32 I32 scopestack_max;
33 ANY *savestack;
34 I32 savestack_ix;
35 I32 savestack_max;
36 OP **retstack;
37 I32 retstack_ix;
38 I32 retstack_max;
39 COP *curcop;
40 203
41 AV *args; 204 /* statistics */
205 int usecount; /* number of switches to this coro */
206
207 /* coro process data */
208 int prio;
209
210 /* linked list */
211 struct coro *next, *prev;
212 HV *hv; /* the perl hash associated with this coro, if any */
42}; 213};
43 214
44typedef struct coro *Coro__State; 215typedef struct coro *Coro__State;
45typedef struct coro *Coro__State_or_hashref; 216typedef struct coro *Coro__State_or_hashref;
46 217
47static HV *padlist_cache; 218/** Coro ********************************************************************/
48 219
49/* mostly copied from op.c:cv_clone2 */ 220#define PRIO_MAX 3
50STATIC AV * 221#define PRIO_HIGH 1
51clone_padlist (AV *protopadlist) 222#define PRIO_NORMAL 0
223#define PRIO_LOW -1
224#define PRIO_IDLE -3
225#define PRIO_MIN -4
226
227/* for Coro.pm */
228static SV *coro_current;
229static AV *coro_ready [PRIO_MAX-PRIO_MIN+1];
230static int coro_nready;
231static struct coro *coro_first;
232
233/** lowlevel stuff **********************************************************/
234
235static AV *
236coro_clone_padlist (pTHX_ CV *cv)
52{ 237{
53 AV *av; 238 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; 239 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 240
72 newpadlist = newAV (); 241 newpadlist = newAV ();
73 AvREAL_off (newpadlist); 242 AvREAL_off (newpadlist);
74 av_store (newpadlist, 0, (SV *) newpad_name); 243#if PERL_VERSION_ATLEAST (5,9,0)
244 Perl_pad_push (aTHX_ padlist, AvFILLp (padlist) + 1);
245#else
246 Perl_pad_push (aTHX_ padlist, AvFILLp (padlist) + 1, 1);
247#endif
248 newpad = (AV *)AvARRAY (padlist)[AvFILLp (padlist)];
249 --AvFILLp (padlist);
250
251 av_store (newpadlist, 0, SvREFCNT_inc (*av_fetch (padlist, 0, FALSE)));
75 av_store (newpadlist, 1, (SV *) newpad); 252 av_store (newpadlist, 1, (SV *)newpad);
76 253
77 av = newAV (); /* will be @_ */ 254 return newpadlist;
78 av_extend (av, 0); 255}
79 av_store (newpad, 0, (SV *) av);
80 AvFLAGS (av) = AVf_REIFY;
81 256
82 for (ix = fpad; ix > 0; ix--) 257static void
258free_padlist (pTHX_ AV *padlist)
259{
260 /* may be during global destruction */
261 if (SvREFCNT (padlist))
83 { 262 {
84 SV *namesv = (ix <= fname) ? pname[ix] : Nullsv; 263 I32 i = AvFILLp (padlist);
85 if (namesv && namesv != &PL_sv_undef) 264 while (i >= 0)
86 { 265 {
87 char *name = SvPVX (namesv); /* XXX */ 266 SV **svp = av_fetch (padlist, i--, FALSE);
88 if (SvFLAGS (namesv) & SVf_FAKE || *name == '&') 267 if (svp)
89 { /* lexical from outside? */
90 npad[ix] = SvREFCNT_inc (ppad[ix]);
91 } 268 {
92 else
93 { /* our own lexical */
94 SV *sv; 269 SV *sv;
95 if (*name == '&') 270 while (&PL_sv_undef != (sv = av_pop ((AV *)*svp)))
96 sv = SvREFCNT_inc (ppad[ix]); 271 SvREFCNT_dec (sv);
97 else if (*name == '@') 272
98 sv = (SV *) newAV (); 273 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 } 274 }
107 } 275 }
108 else if (IS_PADGV (ppad[ix]) || IS_PADCONST (ppad[ix])) 276
277 SvREFCNT_dec ((SV*)padlist);
278 }
279}
280
281static int
282coro_cv_free (pTHX_ SV *sv, MAGIC *mg)
283{
284 AV *padlist;
285 AV *av = (AV *)mg->mg_obj;
286
287 /* casting is fun. */
288 while (&PL_sv_undef != (SV *)(padlist = (AV *)av_pop (av)))
289 free_padlist (aTHX_ padlist);
290
291 SvREFCNT_dec (av);
292
293 return 0;
294}
295
296#define PERL_MAGIC_coro PERL_MAGIC_ext
297
298static MGVTBL vtbl_coro = {0, 0, 0, 0, coro_cv_free};
299
300#define CORO_MAGIC(cv) \
301 SvMAGIC (cv) \
302 ? SvMAGIC (cv)->mg_type == PERL_MAGIC_coro \
303 ? SvMAGIC (cv) \
304 : mg_find ((SV *)cv, PERL_MAGIC_coro) \
305 : 0
306
307static struct coro *
308SvSTATE_ (pTHX_ SV *coro)
309{
310 HV *stash;
311 MAGIC *mg;
312
313 if (SvROK (coro))
314 coro = SvRV (coro);
315
316 if (SvTYPE (coro) != SVt_PVHV)
317 croak ("Coro::State object required");
318
319 stash = SvSTASH (coro);
320 if (stash != coro_stash && stash != coro_state_stash)
321 {
322 /* very slow, but rare, check */
323 if (!sv_derived_from (sv_2mortal (newRV_inc (coro)), "Coro::State"))
324 croak ("Coro::State object required");
325 }
326
327 mg = CORO_MAGIC (coro);
328 return (struct coro *)mg->mg_ptr;
329}
330
331#define SvSTATE(sv) SvSTATE_ (aTHX_ (sv))
332
333/* the next two functions merely cache the padlists */
334static void
335get_padlist (pTHX_ CV *cv)
336{
337 MAGIC *mg = CORO_MAGIC (cv);
338 AV *av;
339
340 if (mg && AvFILLp ((av = (AV *)mg->mg_obj)) >= 0)
341 CvPADLIST (cv) = (AV *)AvARRAY (av)[AvFILLp (av)--];
342 else
343 {
344#if CORO_PREFER_PERL_FUNCTIONS
345 /* this is probably cleaner, but also slower? */
346 CV *cp = Perl_cv_clone (cv);
347 CvPADLIST (cv) = CvPADLIST (cp);
348 CvPADLIST (cp) = 0;
349 SvREFCNT_dec (cp);
350#else
351 CvPADLIST (cv) = coro_clone_padlist (aTHX_ cv);
352#endif
353 }
354}
355
356static void
357put_padlist (pTHX_ CV *cv)
358{
359 MAGIC *mg = CORO_MAGIC (cv);
360 AV *av;
361
362 if (!mg)
363 {
364 sv_magic ((SV *)cv, 0, PERL_MAGIC_coro, 0, 0);
365 mg = mg_find ((SV *)cv, PERL_MAGIC_coro);
366 mg->mg_virtual = &vtbl_coro;
367 mg->mg_obj = (SV *)newAV ();
368 }
369
370 av = (AV *)mg->mg_obj;
371
372 if (AvFILLp (av) >= AvMAX (av))
373 av_extend (av, AvMAX (av) + 1);
374
375 AvARRAY (av)[++AvFILLp (av)] = (SV *)CvPADLIST (cv);
376}
377
378/** load & save, init *******************************************************/
379
380#define SB do {
381#define SE } while (0)
382
383#define REPLACE_SV(sv,val) SB SvREFCNT_dec (sv); (sv) = (val); (val) = 0; SE
384
385static void
386load_perl (pTHX_ Coro__State c)
387{
388#define VAR(name,type) PL_ ## name = c->name;
389# include "state.h"
390#undef VAR
391
392 if (c->defav) REPLACE_SV (GvAV (PL_defgv), c->defav);
393 if (c->defsv) REPLACE_SV (DEFSV , c->defsv);
394 if (c->errsv) REPLACE_SV (ERRSV , c->errsv);
395 if (c->deffh) REPLACE_SV (PL_defoutgv , c->deffh);
396
397 if (c->irssv)
398 {
399 if (c->irssv == PL_rs || sv_eq (PL_rs, c->irssv))
109 { 400 {
110 npad[ix] = SvREFCNT_inc (ppad[ix]); 401 SvREFCNT_dec (c->irssv);
402 c->irssv = 0;
111 } 403 }
112 else 404 else
113 { 405 {
114 SV *sv = NEWSV (0, 0); 406 REPLACE_SV (PL_rs, c->irssv);
115 SvPADTMP_on (sv); 407 if (!c->irssv_sv) c->irssv_sv = get_sv ("/", 0);
116 npad[ix] = sv; 408 sv_setsv (c->irssv_sv, PL_rs);
117 } 409 }
118 } 410 }
119 411
120#if 0 /* NONOTUNDERSTOOD */ 412 {
121 /* Now that vars are all in place, clone nested closures. */ 413 dSP;
414 CV *cv;
122 415
123 for (ix = fpad; ix > 0; ix--) { 416 /* now do the ugly restore mess */
124 SV* namesv = (ix <= fname) ? pname[ix] : Nullsv; 417 while ((cv = (CV *)POPs))
125 if (namesv
126 && namesv != &PL_sv_undef
127 && !(SvFLAGS(namesv) & SVf_FAKE)
128 && *SvPVX(namesv) == '&'
129 && CvCLONE(ppad[ix]))
130 { 418 {
131 CV *kid = cv_clone((CV*)ppad[ix]); 419 put_padlist (aTHX_ cv); /* mark this padlist as available */
132 SvREFCNT_dec(ppad[ix]); 420 CvDEPTH (cv) = PTR2IV (POPs);
133 CvCLONE_on(kid); 421 CvPADLIST (cv) = (AV *)POPs;
134 SvPADMY_on(kid);
135 npad[ix] = (SV*)kid;
136 } 422 }
137 }
138#endif
139 423
140 return newpadlist; 424 PUTBACK;
141}
142
143STATIC AV *
144free_padlist (AV *padlist)
145{
146 /* may be during global destruction */
147 if (SvREFCNT(padlist))
148 {
149 I32 i = AvFILLp(padlist);
150 while (i >= 0)
151 {
152 SV **svp = av_fetch(padlist, i--, FALSE);
153 SV *sv = svp ? *svp : Nullsv;
154 if (sv)
155 SvREFCNT_dec(sv);
156 }
157
158 SvREFCNT_dec((SV*)padlist);
159 } 425 }
160} 426}
161 427
162/* the next tow functions merely cache the padlists */
163STATIC void
164get_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
174STATIC void
175put_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
188static void 428static void
189SAVE(pTHX_ Coro__State c) 429save_perl (pTHX_ Coro__State c)
190{ 430{
191 { 431 {
192 dSP; 432 dSP;
193 I32 cxix = cxstack_ix; 433 I32 cxix = cxstack_ix;
434 PERL_CONTEXT *ccstk = cxstack;
194 PERL_SI *top_si = PL_curstackinfo; 435 PERL_SI *top_si = PL_curstackinfo;
195 PERL_CONTEXT *ccstk = cxstack;
196 436
197 /* 437 /*
198 * the worst thing you can imagine happens first - we have to save 438 * the worst thing you can imagine happens first - we have to save
199 * (and reinitialize) all cv's in the whole callchain :( 439 * (and reinitialize) all cv's in the whole callchain :(
200 */ 440 */
201 441
202 PUSHs (Nullsv); 442 XPUSHs (Nullsv);
203 /* this loop was inspired by pp_caller */ 443 /* this loop was inspired by pp_caller */
204 for (;;) 444 for (;;)
205 { 445 {
206 while (cxix >= 0) 446 while (cxix >= 0)
207 { 447 {
208 PERL_CONTEXT *cx = &ccstk[cxix--]; 448 PERL_CONTEXT *cx = &ccstk[cxix--];
209 449
210 if (CxTYPE(cx) == CXt_SUB) 450 if (CxTYPE (cx) == CXt_SUB || CxTYPE (cx) == CXt_FORMAT)
211 { 451 {
212 CV *cv = cx->blk_sub.cv; 452 CV *cv = cx->blk_sub.cv;
453
213 if (CvDEPTH(cv)) 454 if (CvDEPTH (cv))
214 { 455 {
215#ifdef USE_THREADS
216 XPUSHs ((SV *)CvOWNER(cv));
217#endif
218 EXTEND (SP, 3); 456 EXTEND (SP, 3);
219 PUSHs ((SV *)CvDEPTH(cv));
220 PUSHs ((SV *)CvPADLIST(cv)); 457 PUSHs ((SV *)CvPADLIST (cv));
458 PUSHs (INT2PTR (SV *, CvDEPTH (cv)));
221 PUSHs ((SV *)cv); 459 PUSHs ((SV *)cv);
222 460
223 get_padlist (cv);
224
225 CvDEPTH(cv) = 0; 461 CvDEPTH (cv) = 0;
226#ifdef USE_THREADS 462 get_padlist (aTHX_ cv);
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 } 463 }
233 } 464 }
234 else if (CxTYPE(cx) == CXt_FORMAT)
235 {
236 /* I never used formats, so how should I know how these are implemented? */
237 /* my bold guess is as a simple, plain sub... */
238 croak ("CXt_FORMAT not yet handled. Don't switch coroutines from within formats");
239 }
240 } 465 }
241 466
242 if (top_si->si_type == PERLSI_MAIN) 467 if (top_si->si_type == PERLSI_MAIN)
243 break; 468 break;
244 469
245 top_si = top_si->si_prev; 470 top_si = top_si->si_prev;
246 ccstk = top_si->si_cxstack; 471 ccstk = top_si->si_cxstack;
247 cxix = top_si->si_cxix; 472 cxix = top_si->si_cxix;
248 } 473 }
249 474
250 PUTBACK; 475 PUTBACK;
251 } 476 }
252 477
253 c->dowarn = PL_dowarn; 478 c->defav = c->save & CORO_SAVE_DEFAV ? (AV *)SvREFCNT_inc (GvAV (PL_defgv)) : 0;
254 c->defav = GvAV (PL_defgv); 479 c->defsv = c->save & CORO_SAVE_DEFSV ? SvREFCNT_inc (DEFSV) : 0;
255 c->curstackinfo = PL_curstackinfo; 480 c->errsv = c->save & CORO_SAVE_ERRSV ? SvREFCNT_inc (ERRSV) : 0;
256 c->curstack = PL_curstack; 481 c->deffh = c->save & CORO_SAVE_DEFFH ? (GV *)SvREFCNT_inc (PL_defoutgv) : 0;
257 c->mainstack = PL_mainstack; 482 c->irssv = c->save & CORO_SAVE_IRSSV ? SvREFCNT_inc (PL_rs) : 0;
258 c->stack_sp = PL_stack_sp;
259 c->op = PL_op;
260 c->curpad = PL_curpad;
261 c->stack_base = PL_stack_base;
262 c->stack_max = PL_stack_max;
263 c->tmps_stack = PL_tmps_stack;
264 c->tmps_floor = PL_tmps_floor;
265 c->tmps_ix = PL_tmps_ix;
266 c->tmps_max = PL_tmps_max;
267 c->markstack = PL_markstack;
268 c->markstack_ptr = PL_markstack_ptr;
269 c->markstack_max = PL_markstack_max;
270 c->scopestack = PL_scopestack;
271 c->scopestack_ix = PL_scopestack_ix;
272 c->scopestack_max = PL_scopestack_max;
273 c->savestack = PL_savestack;
274 c->savestack_ix = PL_savestack_ix;
275 c->savestack_max = PL_savestack_max;
276 c->retstack = PL_retstack;
277 c->retstack_ix = PL_retstack_ix;
278 c->retstack_max = PL_retstack_max;
279 c->curcop = PL_curcop;
280}
281 483
484#define VAR(name,type)c->name = PL_ ## name;
485# include "state.h"
486#undef VAR
487}
488
489/*
490 * allocate various perl stacks. This is an exact copy
491 * of perl.c:init_stacks, except that it uses less memory
492 * on the (sometimes correct) assumption that coroutines do
493 * not usually need a lot of stackspace.
494 */
495#if CORO_PREFER_PERL_FUNCTIONS
496# define coro_init_stacks init_stacks
497#else
282static void 498static void
283LOAD(pTHX_ Coro__State c) 499coro_init_stacks (pTHX)
284{ 500{
285 PL_dowarn = c->dowarn;
286 GvAV (PL_defgv) = c->defav;
287 PL_curstackinfo = c->curstackinfo; 501 PL_curstackinfo = new_stackinfo(64, 6);
288 PL_curstack = c->curstack; 502 PL_curstackinfo->si_type = PERLSI_MAIN;
289 PL_mainstack = c->mainstack; 503 PL_curstack = PL_curstackinfo->si_stack;
504 PL_mainstack = PL_curstack; /* remember in case we switch stacks */
505
506 PL_stack_base = AvARRAY(PL_curstack);
290 PL_stack_sp = c->stack_sp; 507 PL_stack_sp = PL_stack_base;
291 PL_op = c->op; 508 PL_stack_max = PL_stack_base + AvMAX(PL_curstack);
292 PL_curpad = c->curpad; 509
293 PL_stack_base = c->stack_base; 510 New(50,PL_tmps_stack,64,SV*);
294 PL_stack_max = c->stack_max; 511 PL_tmps_floor = -1;
295 PL_tmps_stack = c->tmps_stack; 512 PL_tmps_ix = -1;
296 PL_tmps_floor = c->tmps_floor; 513 PL_tmps_max = 64;
297 PL_tmps_ix = c->tmps_ix; 514
298 PL_tmps_max = c->tmps_max; 515 New(54,PL_markstack,16,I32);
299 PL_markstack = c->markstack;
300 PL_markstack_ptr = c->markstack_ptr; 516 PL_markstack_ptr = PL_markstack;
301 PL_markstack_max = c->markstack_max; 517 PL_markstack_max = PL_markstack + 16;
302 PL_scopestack = c->scopestack; 518
303 PL_scopestack_ix = c->scopestack_ix; 519#ifdef SET_MARK_OFFSET
304 PL_scopestack_max = c->scopestack_max; 520 SET_MARK_OFFSET;
305 PL_savestack = c->savestack; 521#endif
306 PL_savestack_ix = c->savestack_ix; 522
307 PL_savestack_max = c->savestack_max; 523 New(54,PL_scopestack,16,I32);
308 PL_retstack = c->retstack; 524 PL_scopestack_ix = 0;
309 PL_retstack_ix = c->retstack_ix; 525 PL_scopestack_max = 16;
310 PL_retstack_max = c->retstack_max; 526
311 PL_curcop = c->curcop; 527 New(54,PL_savestack,64,ANY);
528 PL_savestack_ix = 0;
529 PL_savestack_max = 64;
530
531#if !PERL_VERSION_ATLEAST (5,9,0)
532 New(54,PL_retstack,4,OP*);
533 PL_retstack_ix = 0;
534 PL_retstack_max = 4;
535#endif
536}
537#endif
538
539/*
540 * destroy the stacks, the callchain etc...
541 */
542static void
543coro_destroy_stacks (pTHX)
544{
545 if (!IN_DESTRUCT)
546 {
547 /* restore all saved variables and stuff */
548 LEAVE_SCOPE (0);
549 assert (PL_tmps_floor == -1);
550
551 /* free all temporaries */
552 FREETMPS;
553 assert (PL_tmps_ix == -1);
554
555 /* unwind all extra stacks */
556 POPSTACK_TO (PL_mainstack);
557
558 /* unwind main stack */
559 dounwind (-1);
560 }
561
562 while (PL_curstackinfo->si_next)
563 PL_curstackinfo = PL_curstackinfo->si_next;
564
565 while (PL_curstackinfo)
566 {
567 PERL_SI *p = PL_curstackinfo->si_prev;
568
569 if (!IN_DESTRUCT)
570 SvREFCNT_dec (PL_curstackinfo->si_stack);
571
572 Safefree (PL_curstackinfo->si_cxstack);
573 Safefree (PL_curstackinfo);
574 PL_curstackinfo = p;
575 }
576
577 Safefree (PL_tmps_stack);
578 Safefree (PL_markstack);
579 Safefree (PL_scopestack);
580 Safefree (PL_savestack);
581#if !PERL_VERSION_ATLEAST (5,9,0)
582 Safefree (PL_retstack);
583#endif
584}
585
586static size_t
587coro_rss (pTHX_ struct coro *coro)
588{
589 size_t rss = sizeof (coro);
590
591 if (coro->mainstack)
592 {
593 if (coro->flags & CF_RUNNING)
594 {
595 #define VAR(name,type)coro->name = PL_ ## name;
596 # include "state.h"
597 #undef VAR
598 }
599
600 rss += sizeof (coro->curstackinfo);
601 rss += sizeof (struct xpvav) + (1 + AvFILL (coro->curstackinfo->si_stack)) * sizeof (SV *);
602 rss += (coro->curstackinfo->si_cxmax + 1) * sizeof (PERL_CONTEXT);
603 rss += sizeof (struct xpvav) + (1 + AvFILL (coro->curstack)) * sizeof (SV *);
604 rss += coro->tmps_max * sizeof (SV *);
605 rss += (coro->markstack_max - coro->markstack_ptr) * sizeof (I32);
606 rss += coro->scopestack_max * sizeof (I32);
607 rss += coro->savestack_max * sizeof (ANY);
608
609#if !PERL_VERSION_ATLEAST (5,9,0)
610 rss += coro->retstack_max * sizeof (OP *);
611#endif
612 }
613
614 return rss;
615}
616
617/** coroutine stack handling ************************************************/
618
619static void
620setup_coro (pTHX_ struct coro *coro)
621{
622 /*
623 * emulate part of the perl startup here.
624 */
625 coro_init_stacks (aTHX);
626
627 PL_runops = RUNOPS_DEFAULT;
628 PL_curcop = &PL_compiling;
629 PL_in_eval = EVAL_NULL;
630 PL_comppad = 0;
631 PL_curpm = 0;
632 PL_localizing = 0;
633 PL_dirty = 0;
634 PL_restartop = 0;
312 635
313 { 636 {
314 dSP; 637 dSP;
315 CV *cv; 638 LOGOP myop;
316 639
317 /* now do the ugly restore mess */ 640 SvREFCNT_dec (GvAV (PL_defgv));
318 while ((cv = (CV *)POPs)) 641 GvAV (PL_defgv) = coro->args; coro->args = 0;
319 {
320 AV *padlist = (AV *)POPs;
321 642
322 put_padlist (cv); 643 Zero (&myop, 1, LOGOP);
323 CvPADLIST(cv) = padlist; 644 myop.op_next = Nullop;
324 CvDEPTH(cv) = (I32)POPs; 645 myop.op_flags = OPf_WANT_VOID;
325 646
326#ifdef USE_THREADS 647 PUSHMARK (SP);
327 CvOWNER(cv) = (struct perl_thread *)POPs; 648 XPUSHs (av_shift (GvAV (PL_defgv)));
328 error does not work either
329#endif
330 }
331
332 PUTBACK; 649 PUTBACK;
650 PL_op = (OP *)&myop;
651 PL_op = PL_ppaddr[OP_ENTERSUB](aTHX);
652 SPAGAIN;
333 } 653 }
334}
335 654
336/* this is an EXACT copy of S_nuke_stacks in perl.c, which is unfortunately static */ 655 ENTER; /* necessary e.g. for dounwind */
337STATIC void 656}
338destroy_stacks(pTHX)
339{
340 /* die does this while calling POPSTACK, but I just don't see why. */
341 dounwind(-1);
342 657
343 /* is this ugly, I ask? */ 658static void
344 while (PL_scopestack_ix) 659free_coro_mortal (pTHX)
345 LEAVE; 660{
346 661 if (coro_mortal)
347 while (PL_curstackinfo->si_next) 662 {
348 PL_curstackinfo = PL_curstackinfo->si_next; 663 SvREFCNT_dec (coro_mortal);
349 664 coro_mortal = 0;
350 while (PL_curstackinfo)
351 { 665 }
352 PERL_SI *p = PL_curstackinfo->si_prev; 666}
353 667
354 SvREFCNT_dec(PL_curstackinfo->si_stack); 668static int
355 Safefree(PL_curstackinfo->si_cxstack); 669runops_trace (pTHX)
356 Safefree(PL_curstackinfo); 670{
357 PL_curstackinfo = p; 671 COP *oldcop = 0;
672 int oldcxix = -2;
673 struct coro *coro = SvSTATE (coro_current); /* trace cctx is tied to specific coro */
674 coro_cctx *cctx = coro->cctx;
675
676 while ((PL_op = CALL_FPTR (PL_op->op_ppaddr) (aTHX)))
677 {
678 PERL_ASYNC_CHECK ();
679
680 if (cctx->flags & CC_TRACE_ALL)
681 {
682 if (PL_op->op_type == OP_LEAVESUB && cctx->flags & CC_TRACE_SUB)
683 {
684 PERL_CONTEXT *cx = &cxstack[cxstack_ix];
685 SV **bot, **top;
686 AV *av = newAV (); /* return values */
687 SV **cb;
688 dSP;
689
690 GV *gv = CvGV (cx->blk_sub.cv);
691 SV *fullname = sv_2mortal (newSV (0));
692 if (isGV (gv))
693 gv_efullname3 (fullname, gv, 0);
694
695 bot = PL_stack_base + cx->blk_oldsp + 1;
696 top = cx->blk_gimme == G_ARRAY ? SP + 1
697 : cx->blk_gimme == G_SCALAR ? bot + 1
698 : bot;
699
700 while (bot < top)
701 av_push (av, SvREFCNT_inc (*bot++));
702
703 PL_runops = RUNOPS_DEFAULT;
704 ENTER;
705 SAVETMPS;
706 EXTEND (SP, 3);
707 PUSHMARK (SP);
708 PUSHs (&PL_sv_no);
709 PUSHs (fullname);
710 PUSHs (sv_2mortal (newRV_noinc ((SV *)av)));
711 PUTBACK;
712 cb = hv_fetch ((HV *)SvRV (coro_current), "_trace_sub_cb", sizeof ("_trace_sub_cb") - 1, 0);
713 if (cb) call_sv (*cb, G_KEEPERR | G_EVAL | G_VOID | G_DISCARD);
714 SPAGAIN;
715 FREETMPS;
716 LEAVE;
717 PL_runops = runops_trace;
718 }
719
720 if (oldcop != PL_curcop)
721 {
722 oldcop = PL_curcop;
723
724 if (PL_curcop != &PL_compiling)
725 {
726 SV **cb;
727
728 if (oldcxix != cxstack_ix && cctx->flags & CC_TRACE_SUB)
729 {
730 PERL_CONTEXT *cx = &cxstack[cxstack_ix];
731
732 if (CxTYPE (cx) == CXt_SUB && oldcxix < cxstack_ix)
733 {
734 runops_proc_t old_runops = PL_runops;
735 dSP;
736 GV *gv = CvGV (cx->blk_sub.cv);
737 SV *fullname = sv_2mortal (newSV (0));
738
739 if (isGV (gv))
740 gv_efullname3 (fullname, gv, 0);
741
742 PL_runops = RUNOPS_DEFAULT;
743 ENTER;
744 SAVETMPS;
745 EXTEND (SP, 3);
746 PUSHMARK (SP);
747 PUSHs (&PL_sv_yes);
748 PUSHs (fullname);
749 PUSHs (cx->blk_sub.hasargs ? sv_2mortal (newRV_inc ((SV *)cx->blk_sub.argarray)) : &PL_sv_undef);
750 PUTBACK;
751 cb = hv_fetch ((HV *)SvRV (coro_current), "_trace_sub_cb", sizeof ("_trace_sub_cb") - 1, 0);
752 if (cb) call_sv (*cb, G_KEEPERR | G_EVAL | G_VOID | G_DISCARD);
753 SPAGAIN;
754 FREETMPS;
755 LEAVE;
756 PL_runops = runops_trace;
757 }
758
759 oldcxix = cxstack_ix;
760 }
761
762 if (cctx->flags & CC_TRACE_LINE)
763 {
764 dSP;
765
766 PL_runops = RUNOPS_DEFAULT;
767 ENTER;
768 SAVETMPS;
769 EXTEND (SP, 3);
770 PL_runops = RUNOPS_DEFAULT;
771 PUSHMARK (SP);
772 PUSHs (sv_2mortal (newSVpv (OutCopFILE (oldcop), 0)));
773 PUSHs (sv_2mortal (newSViv (CopLINE (oldcop))));
774 PUTBACK;
775 cb = hv_fetch ((HV *)SvRV (coro_current), "_trace_line_cb", sizeof ("_trace_line_cb") - 1, 0);
776 if (cb) call_sv (*cb, G_KEEPERR | G_EVAL | G_VOID | G_DISCARD);
777 SPAGAIN;
778 FREETMPS;
779 LEAVE;
780 PL_runops = runops_trace;
781 }
782 }
783 }
784 }
358 } 785 }
359 786
360 if (PL_scopestack_ix != 0) 787 TAINT_NOT;
361 Perl_warner(aTHX_ WARN_INTERNAL, 788 return 0;
362 "Unbalanced scopes: %ld more ENTERs than LEAVEs\n", 789}
363 (long)PL_scopestack_ix); 790
364 if (PL_savestack_ix != 0) 791/* inject a fake call to Coro::State::_cctx_init into the execution */
365 Perl_warner(aTHX_ WARN_INTERNAL, 792/* _cctx_init should be careful, as it could be called at almost any time */
366 "Unbalanced saves: %ld more saves than restores\n", 793/* during execution of a perl program */
367 (long)PL_savestack_ix); 794static void NOINLINE
368 if (PL_tmps_floor != -1) 795prepare_cctx (pTHX_ coro_cctx *cctx)
369 Perl_warner(aTHX_ WARN_INTERNAL,"Unbalanced tmps: %ld more allocs than frees\n", 796{
370 (long)PL_tmps_floor + 1); 797 dSP;
798 LOGOP myop;
799
800 PL_top_env = &PL_start_env;
801
802 if (cctx->flags & CC_TRACE)
803 PL_runops = runops_trace;
804
805 Zero (&myop, 1, LOGOP);
806 myop.op_next = PL_op;
807 myop.op_flags = OPf_WANT_VOID | OPf_STACKED;
808
809 PUSHMARK (SP);
810 EXTEND (SP, 2);
811 PUSHs (sv_2mortal (newSViv (PTR2IV (cctx))));
812 PUSHs ((SV *)get_cv ("Coro::State::_cctx_init", FALSE));
813 PUTBACK;
814 PL_op = (OP *)&myop;
815 PL_op = PL_ppaddr[OP_ENTERSUB](aTHX);
816 SPAGAIN;
817}
818
819/*
820 * this is a _very_ stripped down perl interpreter ;)
821 */
822static void
823coro_run (void *arg)
824{
825 dTHX;
826
827 /* coro_run is the alternative tail of transfer(), so unlock here. */
828 UNLOCK;
829
830 /* we now skip the entersub that lead to transfer() */
831 PL_op = PL_op->op_next;
832
833 /* inject a fake subroutine call to cctx_init */
834 prepare_cctx (aTHX_ (coro_cctx *)arg);
835
836 /* somebody or something will hit me for both perl_run and PL_restartop */
837 PL_restartop = PL_op;
838 perl_run (PL_curinterp);
839
371 /* 840 /*
372 */ 841 * If perl-run returns we assume exit() was being called or the coro
373 Safefree(PL_tmps_stack); 842 * fell off the end, which seems to be the only valid (non-bug)
374 Safefree(PL_markstack); 843 * reason for perl_run to return. We try to exit by jumping to the
375 Safefree(PL_scopestack); 844 * bootstrap-time "top" top_env, as we cannot restore the "main"
376 Safefree(PL_savestack); 845 * coroutine as Coro has no such concept
377 Safefree(PL_retstack); 846 */
847 PL_top_env = main_top_env;
848 JMPENV_JUMP (2); /* I do not feel well about the hardcoded 2 at all */
378} 849}
379 850
380#define SUB_INIT "Coro::State::_newcoro" 851static coro_cctx *
852cctx_new ()
853{
854 coro_cctx *cctx;
855 void *stack_start;
856 size_t stack_size;
381 857
858 ++cctx_count;
859
860 Newz (0, cctx, 1, coro_cctx);
861
862#if HAVE_MMAP
863
864 cctx->ssize = ((coro_stacksize * sizeof (long) + PAGESIZE - 1) / PAGESIZE + CORO_STACKGUARD) * PAGESIZE;
865 /* mmap supposedly does allocate-on-write for us */
866 cctx->sptr = mmap (0, cctx->ssize, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_PRIVATE|MAP_ANONYMOUS, 0, 0);
867
868 if (cctx->sptr != (void *)-1)
869 {
870# if CORO_STACKGUARD
871 mprotect (cctx->sptr, CORO_STACKGUARD * PAGESIZE, PROT_NONE);
872# endif
873 stack_start = CORO_STACKGUARD * PAGESIZE + (char *)cctx->sptr;
874 stack_size = cctx->ssize - CORO_STACKGUARD * PAGESIZE;
875 cctx->flags |= CC_MAPPED;
876 }
877 else
878#endif
879 {
880 cctx->ssize = coro_stacksize * (long)sizeof (long);
881 New (0, cctx->sptr, coro_stacksize, long);
882
883 if (!cctx->sptr)
884 {
885 perror ("FATAL: unable to allocate stack for coroutine");
886 _exit (EXIT_FAILURE);
887 }
888
889 stack_start = cctx->sptr;
890 stack_size = cctx->ssize;
891 }
892
893 REGISTER_STACK (cctx, (char *)stack_start, (char *)stack_start + stack_size);
894 coro_create (&cctx->cctx, coro_run, (void *)cctx, stack_start, stack_size);
895
896 return cctx;
897}
898
899static void
900cctx_destroy (coro_cctx *cctx)
901{
902 if (!cctx)
903 return;
904
905 --cctx_count;
906
907#if CORO_USE_VALGRIND
908 VALGRIND_STACK_DEREGISTER (cctx->valgrind_id);
909#endif
910
911#if HAVE_MMAP
912 if (cctx->flags & CC_MAPPED)
913 munmap (cctx->sptr, cctx->ssize);
914 else
915#endif
916 Safefree (cctx->sptr);
917
918 Safefree (cctx);
919}
920
921static coro_cctx *
922cctx_get (pTHX)
923{
924 while (cctx_first)
925 {
926 coro_cctx *cctx = cctx_first;
927 cctx_first = cctx->next;
928 --cctx_idle;
929
930 if (cctx->ssize >= coro_stacksize && !(cctx->flags & CC_NOREUSE))
931 return cctx;
932
933 cctx_destroy (cctx);
934 }
935
936 return cctx_new ();
937}
938
939static void
940cctx_put (coro_cctx *cctx)
941{
942 /* free another cctx if overlimit */
943 if (cctx_idle >= MAX_IDLE_CCTX)
944 {
945 coro_cctx *first = cctx_first;
946 cctx_first = first->next;
947 --cctx_idle;
948
949 cctx_destroy (first);
950 }
951
952 ++cctx_idle;
953 cctx->next = cctx_first;
954 cctx_first = cctx;
955}
956
957/** coroutine switching *****************************************************/
958
959static void NOINLINE
960transfer_check (pTHX_ struct coro *prev, struct coro *next)
961{
962 if (prev != next)
963 {
964 if (!(prev->flags & (CF_RUNNING | CF_NEW)))
965 croak ("Coro::State::transfer called with non-running/new prev Coro::State, but can only transfer from running or new states");
966
967 if (next->flags & CF_RUNNING)
968 croak ("Coro::State::transfer called with running next Coro::State, but can only transfer to inactive states");
969
970 if (next->flags & CF_DESTROYED)
971 croak ("Coro::State::transfer called with destroyed next Coro::State, but can only transfer to inactive states");
972
973 if (PL_lex_state != LEX_NOTPARSING)
974 croak ("Coro::State::transfer called while parsing, but this is not supported");
975 }
976}
977
978/* always use the TRANSFER macro */
979static void NOINLINE
980transfer (pTHX_ struct coro *prev, struct coro *next)
981{
982 dSTACKLEVEL;
983
984 /* sometimes transfer is only called to set idle_sp */
985 if (!next)
986 {
987 ((coro_cctx *)prev)->idle_sp = STACKLEVEL;
988 assert (((coro_cctx *)prev)->idle_te = PL_top_env); /* just for the side-effect when asserts are enabled */
989 }
990 else if (prev != next)
991 {
992 coro_cctx *prev__cctx;
993
994 if (prev->flags & CF_NEW)
995 {
996 /* create a new empty context */
997 Newz (0, prev->cctx, 1, coro_cctx);
998 prev->flags &= ~CF_NEW;
999 prev->flags |= CF_RUNNING;
1000 }
1001
1002 prev->flags &= ~CF_RUNNING;
1003 next->flags |= CF_RUNNING;
1004
1005 LOCK;
1006
1007 if (next->flags & CF_NEW)
1008 {
1009 /* need to start coroutine */
1010 next->flags &= ~CF_NEW;
1011 /* first get rid of the old state */
1012 save_perl (aTHX_ prev);
1013 /* setup coroutine call */
1014 setup_coro (aTHX_ next);
1015 }
1016 else
1017 {
1018 /* coroutine already started */
1019 save_perl (aTHX_ prev);
1020 load_perl (aTHX_ next);
1021 }
1022
1023 prev__cctx = prev->cctx;
1024
1025 /* possibly "free" the cctx */
1026 if (prev__cctx->idle_sp == STACKLEVEL && !(prev__cctx->flags & CC_TRACE))
1027 {
1028 /* I assume that STACKLEVEL is a stronger indicator than PL_top_env changes */
1029 assert (("ERROR: current top_env must equal previous top_env", PL_top_env == prev__cctx->idle_te));
1030
1031 prev->cctx = 0;
1032
1033 cctx_put (prev__cctx);
1034 }
1035
1036 ++next->usecount;
1037
1038 if (!next->cctx)
1039 next->cctx = cctx_get (aTHX);
1040
1041 if (prev__cctx != next->cctx)
1042 {
1043 prev__cctx->top_env = PL_top_env;
1044 PL_top_env = next->cctx->top_env;
1045 coro_transfer (&prev__cctx->cctx, &next->cctx->cctx);
1046 }
1047
1048 free_coro_mortal (aTHX);
1049 UNLOCK;
1050 }
1051}
1052
1053struct transfer_args
1054{
1055 struct coro *prev, *next;
1056};
1057
1058#define TRANSFER(ta) transfer (aTHX_ (ta).prev, (ta).next)
1059#define TRANSFER_CHECK(ta) transfer_check (aTHX_ (ta).prev, (ta).next)
1060
1061/** high level stuff ********************************************************/
1062
1063static int
1064coro_state_destroy (pTHX_ struct coro *coro)
1065{
1066 if (coro->flags & CF_DESTROYED)
1067 return 0;
1068
1069 coro->flags |= CF_DESTROYED;
1070
1071 if (coro->flags & CF_READY)
1072 {
1073 /* reduce nready, as destroying a ready coro effectively unreadies it */
1074 /* alternative: look through all ready queues and remove the coro */
1075 LOCK;
1076 --coro_nready;
1077 UNLOCK;
1078 }
1079 else
1080 coro->flags |= CF_READY; /* make sure it is NOT put into the readyqueue */
1081
1082 if (coro->mainstack && coro->mainstack != main_mainstack)
1083 {
1084 struct coro temp;
1085
1086 assert (!(coro->flags & CF_RUNNING));
1087
1088 Zero (&temp, 1, struct coro);
1089 temp.save = CORO_SAVE_ALL;
1090
1091 if (coro->flags & CF_RUNNING)
1092 croak ("FATAL: tried to destroy currently running coroutine");
1093
1094 save_perl (aTHX_ &temp);
1095 load_perl (aTHX_ coro);
1096
1097 coro_destroy_stacks (aTHX);
1098
1099 load_perl (aTHX_ &temp); /* this will get rid of defsv etc.. */
1100
1101 coro->mainstack = 0;
1102 }
1103
1104 cctx_destroy (coro->cctx);
1105 SvREFCNT_dec (coro->args);
1106
1107 if (coro->next) coro->next->prev = coro->prev;
1108 if (coro->prev) coro->prev->next = coro->next;
1109 if (coro == coro_first) coro_first = coro->next;
1110
1111 return 1;
1112}
1113
1114static int
1115coro_state_free (pTHX_ SV *sv, MAGIC *mg)
1116{
1117 struct coro *coro = (struct coro *)mg->mg_ptr;
1118 mg->mg_ptr = 0;
1119
1120 coro->hv = 0;
1121
1122 if (--coro->refcnt < 0)
1123 {
1124 coro_state_destroy (aTHX_ coro);
1125 Safefree (coro);
1126 }
1127
1128 return 0;
1129}
1130
1131static int
1132coro_state_dup (pTHX_ MAGIC *mg, CLONE_PARAMS *params)
1133{
1134 struct coro *coro = (struct coro *)mg->mg_ptr;
1135
1136 ++coro->refcnt;
1137
1138 return 0;
1139}
1140
1141static MGVTBL coro_state_vtbl = {
1142 0, 0, 0, 0,
1143 coro_state_free,
1144 0,
1145#ifdef MGf_DUP
1146 coro_state_dup,
1147#else
1148# define MGf_DUP 0
1149#endif
1150};
1151
1152static void
1153prepare_transfer (pTHX_ struct transfer_args *ta, SV *prev_sv, SV *next_sv)
1154{
1155 ta->prev = SvSTATE (prev_sv);
1156 ta->next = SvSTATE (next_sv);
1157 TRANSFER_CHECK (*ta);
1158}
1159
1160static void
1161api_transfer (SV *prev_sv, SV *next_sv)
1162{
1163 dTHX;
1164 struct transfer_args ta;
1165
1166 prepare_transfer (aTHX_ &ta, prev_sv, next_sv);
1167 TRANSFER (ta);
1168}
1169
1170static int
1171api_save (SV *coro_sv, int new_save)
1172{
1173 dTHX;
1174 struct coro *coro = SvSTATE (coro_sv);
1175 int old_save = coro->save;
1176
1177 if (new_save >= 0)
1178 coro->save = new_save;
1179
1180 return old_save;
1181}
1182
1183/** Coro ********************************************************************/
1184
1185static void
1186coro_enq (pTHX_ SV *coro_sv)
1187{
1188 av_push (coro_ready [SvSTATE (coro_sv)->prio - PRIO_MIN], coro_sv);
1189}
1190
1191static SV *
1192coro_deq (pTHX_ int min_prio)
1193{
1194 int prio = PRIO_MAX - PRIO_MIN;
1195
1196 min_prio -= PRIO_MIN;
1197 if (min_prio < 0)
1198 min_prio = 0;
1199
1200 for (prio = PRIO_MAX - PRIO_MIN + 1; --prio >= min_prio; )
1201 if (AvFILLp (coro_ready [prio]) >= 0)
1202 return av_shift (coro_ready [prio]);
1203
1204 return 0;
1205}
1206
1207static int
1208api_ready (SV *coro_sv)
1209{
1210 dTHX;
1211 struct coro *coro;
1212
1213 if (SvROK (coro_sv))
1214 coro_sv = SvRV (coro_sv);
1215
1216 coro = SvSTATE (coro_sv);
1217
1218 if (coro->flags & CF_READY)
1219 return 0;
1220
1221 coro->flags |= CF_READY;
1222
1223 LOCK;
1224 coro_enq (aTHX_ SvREFCNT_inc (coro_sv));
1225 ++coro_nready;
1226 UNLOCK;
1227
1228 return 1;
1229}
1230
1231static int
1232api_is_ready (SV *coro_sv)
1233{
1234 dTHX;
1235 return !!(SvSTATE (coro_sv)->flags & CF_READY);
1236}
1237
1238static void
1239prepare_schedule (pTHX_ struct transfer_args *ta)
1240{
1241 SV *prev_sv, *next_sv;
1242
1243 for (;;)
1244 {
1245 LOCK;
1246 next_sv = coro_deq (aTHX_ PRIO_MIN);
1247
1248 /* nothing to schedule: call the idle handler */
1249 if (!next_sv)
1250 {
1251 dSP;
1252 UNLOCK;
1253
1254 ENTER;
1255 SAVETMPS;
1256
1257 PUSHMARK (SP);
1258 PUTBACK;
1259 call_sv (get_sv ("Coro::idle", FALSE), G_DISCARD);
1260
1261 FREETMPS;
1262 LEAVE;
1263 continue;
1264 }
1265
1266 ta->next = SvSTATE (next_sv);
1267
1268 /* cannot transfer to destroyed coros, skip and look for next */
1269 if (ta->next->flags & CF_DESTROYED)
1270 {
1271 UNLOCK;
1272 SvREFCNT_dec (next_sv);
1273 /* coro_nready is already taken care of by destroy */
1274 continue;
1275 }
1276
1277 --coro_nready;
1278 UNLOCK;
1279 break;
1280 }
1281
1282 /* free this only after the transfer */
1283 prev_sv = SvRV (coro_current);
1284 ta->prev = SvSTATE (prev_sv);
1285 TRANSFER_CHECK (*ta);
1286 assert (ta->next->flags & CF_READY);
1287 ta->next->flags &= ~CF_READY;
1288 SvRV_set (coro_current, next_sv);
1289
1290 LOCK;
1291 free_coro_mortal (aTHX);
1292 coro_mortal = prev_sv;
1293 UNLOCK;
1294}
1295
1296static void
1297prepare_cede (pTHX_ struct transfer_args *ta)
1298{
1299 api_ready (coro_current);
1300 prepare_schedule (aTHX_ ta);
1301}
1302
1303static int
1304prepare_cede_notself (pTHX_ struct transfer_args *ta)
1305{
1306 if (coro_nready)
1307 {
1308 SV *prev = SvRV (coro_current);
1309 prepare_schedule (aTHX_ ta);
1310 api_ready (prev);
1311 return 1;
1312 }
1313 else
1314 return 0;
1315}
1316
1317static void
1318api_schedule (void)
1319{
1320 dTHX;
1321 struct transfer_args ta;
1322
1323 prepare_schedule (aTHX_ &ta);
1324 TRANSFER (ta);
1325}
1326
1327static int
1328api_cede (void)
1329{
1330 dTHX;
1331 struct transfer_args ta;
1332
1333 prepare_cede (aTHX_ &ta);
1334
1335 if (ta.prev != ta.next)
1336 {
1337 TRANSFER (ta);
1338 return 1;
1339 }
1340 else
1341 return 0;
1342}
1343
1344static int
1345api_cede_notself (void)
1346{
1347 dTHX;
1348 struct transfer_args ta;
1349
1350 if (prepare_cede_notself (aTHX_ &ta))
1351 {
1352 TRANSFER (ta);
1353 return 1;
1354 }
1355 else
1356 return 0;
1357}
1358
1359static void
1360api_trace (SV *coro_sv, int flags)
1361{
1362 dTHX;
1363 struct coro *coro = SvSTATE (coro_sv);
1364
1365 if (flags & CC_TRACE)
1366 {
1367 if (!coro->cctx)
1368 coro->cctx = cctx_new ();
1369 else if (!(coro->cctx->flags & CC_TRACE))
1370 croak ("cannot enable tracing on coroutine with custom stack");
1371
1372 coro->cctx->flags |= CC_NOREUSE | (flags & (CC_TRACE | CC_TRACE_ALL));
1373 }
1374 else if (coro->cctx && coro->cctx->flags & CC_TRACE)
1375 {
1376 coro->cctx->flags &= ~(CC_TRACE | CC_TRACE_ALL);
1377
1378 if (coro->flags & CF_RUNNING)
1379 PL_runops = RUNOPS_DEFAULT;
1380 else
1381 coro->runops = RUNOPS_DEFAULT;
1382 }
1383}
1384
382MODULE = Coro::State PACKAGE = Coro::State 1385MODULE = Coro::State PACKAGE = Coro::State PREFIX = api_
383 1386
384PROTOTYPES: ENABLE 1387PROTOTYPES: DISABLE
385 1388
386BOOT: 1389BOOT:
387 if (!padlist_cache) 1390{
388 padlist_cache = newHV (); 1391#ifdef USE_ITHREADS
1392 MUTEX_INIT (&coro_mutex);
1393#endif
1394 BOOT_PAGESIZE;
389 1395
390Coro::State 1396 coro_state_stash = gv_stashpv ("Coro::State", TRUE);
391_newprocess(args) 1397
392 SV * args 1398 newCONSTSUB (coro_state_stash, "CC_TRACE" , newSViv (CC_TRACE));
393 PROTOTYPE: $ 1399 newCONSTSUB (coro_state_stash, "CC_TRACE_SUB" , newSViv (CC_TRACE_SUB));
1400 newCONSTSUB (coro_state_stash, "CC_TRACE_LINE", newSViv (CC_TRACE_LINE));
1401 newCONSTSUB (coro_state_stash, "CC_TRACE_ALL" , newSViv (CC_TRACE_ALL));
1402
1403 newCONSTSUB (coro_state_stash, "SAVE_DEFAV", newSViv (CORO_SAVE_DEFAV));
1404 newCONSTSUB (coro_state_stash, "SAVE_DEFSV", newSViv (CORO_SAVE_DEFSV));
1405 newCONSTSUB (coro_state_stash, "SAVE_ERRSV", newSViv (CORO_SAVE_ERRSV));
1406 newCONSTSUB (coro_state_stash, "SAVE_IRSSV", newSViv (CORO_SAVE_IRSSV));
1407 newCONSTSUB (coro_state_stash, "SAVE_DEFFH", newSViv (CORO_SAVE_DEFFH));
1408 newCONSTSUB (coro_state_stash, "SAVE_DEF", newSViv (CORO_SAVE_DEF));
1409 newCONSTSUB (coro_state_stash, "SAVE_ALL", newSViv (CORO_SAVE_ALL));
1410
1411 main_mainstack = PL_mainstack;
1412 main_top_env = PL_top_env;
1413
1414 while (main_top_env->je_prev)
1415 main_top_env = main_top_env->je_prev;
1416
1417 coroapi.ver = CORO_API_VERSION;
1418 coroapi.transfer = api_transfer;
1419
1420 assert (("PRIO_NORMAL must be 0", !PRIO_NORMAL));
1421}
1422
1423SV *
1424new (char *klass, ...)
394 CODE: 1425 CODE:
395 Coro__State coro; 1426{
1427 struct coro *coro;
1428 HV *hv;
1429 int i;
396 1430
397 if (!SvROK (args) || SvTYPE (SvRV (args)) != SVt_PVAV)
398 croak ("Coro::State::newprocess expects an arrayref");
399
400 New (0, coro, 1, struct coro); 1431 Newz (0, coro, 1, struct coro);
1432 coro->args = newAV ();
1433 coro->save = CORO_SAVE_DEF;
1434 coro->flags = CF_NEW;
401 1435
402 coro->mainstack = 0; /* actual work is done inside transfer */ 1436 if (coro_first) coro_first->prev = coro;
403 coro->args = (AV *)SvREFCNT_inc (SvRV (args)); 1437 coro->next = coro_first;
1438 coro_first = coro;
404 1439
405 RETVAL = coro; 1440 coro->hv = hv = newHV ();
1441 sv_magicext ((SV *)hv, 0, PERL_MAGIC_ext, &coro_state_vtbl, (char *)coro, 0)->mg_flags |= MGf_DUP;
1442 RETVAL = sv_bless (newRV_noinc ((SV *)hv), gv_stashpv (klass, 1));
1443
1444 for (i = 1; i < items; i++)
1445 av_push (coro->args, newSVsv (ST (i)));
1446}
406 OUTPUT: 1447 OUTPUT:
407 RETVAL 1448 RETVAL
408 1449
1450int
1451save (SV *coro, int new_save = -1)
1452 CODE:
1453 RETVAL = api_save (coro, new_save);
1454 OUTPUT:
1455 RETVAL
1456
1457int
1458save_also (SV *coro_sv, int save_also)
1459 CODE:
1460{
1461 struct coro *coro = SvSTATE (coro_sv);
1462 RETVAL = coro->save;
1463 coro->save |= save_also;
1464}
1465 OUTPUT:
1466 RETVAL
1467
409void 1468void
410transfer(prev,next) 1469_set_stacklevel (...)
411 Coro::State_or_hashref prev 1470 ALIAS:
412 Coro::State_or_hashref next 1471 Coro::State::transfer = 1
1472 Coro::schedule = 2
1473 Coro::cede = 3
1474 Coro::cede_notself = 4
413 CODE: 1475 CODE:
1476{
1477 struct transfer_args ta;
414 1478
415 if (prev != next) 1479 switch (ix)
416 { 1480 {
417 PUTBACK;
418 SAVE (aTHX_ prev);
419
420 /*
421 * this could be done in newprocess which would lead to
422 * extremely elegant and fast (just PUTBACK/SAVE/LOAD/SPAGAIN)
423 * code here, but lazy allocation of stacks has also
424 * some virtues and the overhead of the if() is nil.
425 */
426 if (next->mainstack)
427 {
428 LOAD (aTHX_ next);
429 next->mainstack = 0; /* unnecessary but much cleaner */
430 SPAGAIN;
431 }
432 else 1481 case 0:
1482 ta.prev = (struct coro *)INT2PTR (coro_cctx *, SvIV (ST (0)));
1483 ta.next = 0;
433 { 1484 break;
434 /*
435 * emulate part of the perl startup here.
436 */
437 UNOP myop;
438 1485
439 init_stacks (); /* from perl.c */ 1486 case 1:
440 PL_op = (OP *)&myop; 1487 if (items != 2)
441 /*PL_curcop = 0;*/ 1488 croak ("Coro::State::transfer (prev,next) expects two arguments, not %d", items);
442 GvAV (PL_defgv) = (AV *)SvREFCNT_inc ((SV *)next->args);
443 1489
444 SPAGAIN; 1490 prepare_transfer (aTHX_ &ta, ST (0), ST (1));
445 Zero(&myop, 1, UNOP);
446 myop.op_next = Nullop;
447 myop.op_flags = OPf_WANT_VOID;
448
449 PUSHMARK(SP);
450 XPUSHs ((SV*)get_cv(SUB_INIT, TRUE));
451 PUTBACK;
452 /*
453 * the next line is slightly wrong, as PL_op->op_next
454 * is actually being executed so we skip the first op.
455 * that doesn't matter, though, since it is only
456 * pp_nextstate and we never return...
457 */
458 PL_op = Perl_pp_entersub(aTHX);
459 SPAGAIN;
460
461 ENTER;
462 } 1491 break;
1492
1493 case 2:
1494 prepare_schedule (aTHX_ &ta);
1495 break;
1496
1497 case 3:
1498 prepare_cede (aTHX_ &ta);
1499 break;
1500
1501 case 4:
1502 if (!prepare_cede_notself (aTHX_ &ta))
1503 XSRETURN_EMPTY;
1504
1505 break;
463 } 1506 }
464 1507
1508 BARRIER;
1509 TRANSFER (ta);
1510
1511 if (GIMME_V != G_VOID && ta.next != ta.prev)
1512 XSRETURN_YES;
1513}
1514
1515bool
1516_destroy (SV *coro_sv)
1517 CODE:
1518 RETVAL = coro_state_destroy (aTHX_ SvSTATE (coro_sv));
1519 OUTPUT:
1520 RETVAL
1521
465void 1522void
466DESTROY(coro) 1523_exit (code)
467 Coro::State coro 1524 int code
468 CODE: 1525 PROTOTYPE: $
1526 CODE:
1527 _exit (code);
469 1528
1529int
1530cctx_stacksize (int new_stacksize = 0)
1531 CODE:
1532 RETVAL = coro_stacksize;
1533 if (new_stacksize)
1534 coro_stacksize = new_stacksize;
1535 OUTPUT:
1536 RETVAL
1537
1538int
1539cctx_count ()
1540 CODE:
1541 RETVAL = cctx_count;
1542 OUTPUT:
1543 RETVAL
1544
1545int
1546cctx_idle ()
1547 CODE:
1548 RETVAL = cctx_idle;
1549 OUTPUT:
1550 RETVAL
1551
1552void
1553list ()
1554 PPCODE:
1555{
1556 struct coro *coro;
1557 for (coro = coro_first; coro; coro = coro->next)
1558 if (coro->hv)
1559 XPUSHs (sv_2mortal (newRV_inc ((SV *)coro->hv)));
1560}
1561
1562void
1563call (Coro::State coro, SV *coderef)
1564 ALIAS:
1565 eval = 1
1566 CODE:
1567{
470 if (coro->mainstack) 1568 if (coro->mainstack)
471 { 1569 {
472 struct coro temp; 1570 struct coro temp;
1571 Zero (&temp, 1, struct coro);
1572 temp.save = CORO_SAVE_ALL;
473 1573
1574 if (!(coro->flags & CF_RUNNING))
1575 {
1576 save_perl (aTHX_ &temp);
1577 load_perl (aTHX_ coro);
1578 }
1579
1580 {
1581 dSP;
1582 ENTER;
1583 SAVETMPS;
1584 PUSHMARK (SP);
474 PUTBACK; 1585 PUTBACK;
475 SAVE(aTHX_ (&temp)); 1586 if (ix)
476 LOAD(aTHX_ coro); 1587 eval_sv (coderef, 0);
477 1588 else
478 destroy_stacks (); 1589 call_sv (coderef, G_KEEPERR | G_EVAL | G_VOID | G_DISCARD);
479 SvREFCNT_dec ((SV *)GvAV (PL_defgv));
480
481 LOAD((&temp));
482 SPAGAIN; 1590 SPAGAIN;
1591 FREETMPS;
1592 LEAVE;
1593 PUTBACK;
1594 }
1595
1596 if (!(coro->flags & CF_RUNNING))
1597 {
1598 save_perl (aTHX_ coro);
1599 load_perl (aTHX_ &temp);
1600 }
483 } 1601 }
1602}
484 1603
1604SV *
1605is_ready (Coro::State coro)
1606 PROTOTYPE: $
1607 ALIAS:
1608 is_ready = CF_READY
1609 is_running = CF_RUNNING
1610 is_new = CF_NEW
1611 is_destroyed = CF_DESTROYED
1612 CODE:
1613 RETVAL = boolSV (coro->flags & ix);
1614 OUTPUT:
1615 RETVAL
1616
1617void
1618api_trace (SV *coro, int flags = CC_TRACE | CC_TRACE_SUB)
1619
1620SV *
1621has_stack (Coro::State coro)
1622 PROTOTYPE: $
1623 CODE:
1624 RETVAL = boolSV (!!coro->cctx);
1625 OUTPUT:
1626 RETVAL
1627
1628int
1629is_traced (Coro::State coro)
1630 PROTOTYPE: $
1631 CODE:
1632 RETVAL = (coro->cctx ? coro->cctx->flags : 0) & CC_TRACE_ALL;
1633 OUTPUT:
1634 RETVAL
1635
1636IV
1637rss (Coro::State coro)
1638 PROTOTYPE: $
1639 ALIAS:
1640 usecount = 1
1641 CODE:
1642 switch (ix)
1643 {
1644 case 0: RETVAL = coro_rss (aTHX_ coro); break;
1645 case 1: RETVAL = coro->usecount; break;
1646 }
1647 OUTPUT:
1648 RETVAL
1649
1650
1651MODULE = Coro::State PACKAGE = Coro
1652
1653BOOT:
1654{
1655 int i;
1656
1657 sv_pool_rss = get_sv ("Coro::POOL_RSS" , TRUE);
1658 sv_pool_size = get_sv ("Coro::POOL_SIZE" , TRUE);
1659 av_async_pool = get_av ("Coro::async_pool", TRUE);
1660
1661 coro_current = get_sv ("Coro::current", FALSE);
1662 SvREADONLY_on (coro_current);
1663
1664 coro_stash = gv_stashpv ("Coro", TRUE);
1665
1666 newCONSTSUB (coro_stash, "PRIO_MAX", newSViv (PRIO_MAX));
1667 newCONSTSUB (coro_stash, "PRIO_HIGH", newSViv (PRIO_HIGH));
1668 newCONSTSUB (coro_stash, "PRIO_NORMAL", newSViv (PRIO_NORMAL));
1669 newCONSTSUB (coro_stash, "PRIO_LOW", newSViv (PRIO_LOW));
1670 newCONSTSUB (coro_stash, "PRIO_IDLE", newSViv (PRIO_IDLE));
1671 newCONSTSUB (coro_stash, "PRIO_MIN", newSViv (PRIO_MIN));
1672
1673 for (i = PRIO_MAX - PRIO_MIN + 1; i--; )
1674 coro_ready[i] = newAV ();
1675
1676 {
1677 SV *sv = perl_get_sv("Coro::API", 1);
1678
1679 coroapi.schedule = api_schedule;
1680 coroapi.save = api_save;
1681 coroapi.cede = api_cede;
1682 coroapi.cede_notself = api_cede_notself;
1683 coroapi.ready = api_ready;
1684 coroapi.is_ready = api_is_ready;
1685 coroapi.nready = &coro_nready;
1686 coroapi.current = coro_current;
1687
1688 GCoroAPI = &coroapi;
1689 sv_setiv (sv, (IV)&coroapi);
1690 SvREADONLY_on (sv);
1691 }
1692}
1693
1694void
1695_set_current (SV *current)
1696 PROTOTYPE: $
1697 CODE:
1698 SvREFCNT_dec (SvRV (coro_current));
1699 SvRV_set (coro_current, SvREFCNT_inc (SvRV (current)));
1700
1701int
1702prio (Coro::State coro, int newprio = 0)
1703 ALIAS:
1704 nice = 1
1705 CODE:
1706{
1707 RETVAL = coro->prio;
1708
1709 if (items > 1)
1710 {
1711 if (ix)
1712 newprio = coro->prio - newprio;
1713
1714 if (newprio < PRIO_MIN) newprio = PRIO_MIN;
1715 if (newprio > PRIO_MAX) newprio = PRIO_MAX;
1716
1717 coro->prio = newprio;
1718 }
1719}
1720 OUTPUT:
1721 RETVAL
1722
1723SV *
1724ready (SV *self)
1725 PROTOTYPE: $
1726 CODE:
1727 RETVAL = boolSV (api_ready (self));
1728 OUTPUT:
1729 RETVAL
1730
1731int
1732nready (...)
1733 PROTOTYPE:
1734 CODE:
1735 RETVAL = coro_nready;
1736 OUTPUT:
1737 RETVAL
1738
1739# for async_pool speedup
1740void
1741_pool_1 (SV *cb)
1742 CODE:
1743{
1744 int i, len;
1745 HV *hv = (HV *)SvRV (coro_current);
1746 AV *defav = GvAV (PL_defgv);
1747 SV *invoke = hv_delete (hv, "_invoke", sizeof ("_invoke") - 1, 0);
1748 AV *invoke_av;
1749
1750 if (!invoke)
1751 croak ("\3terminate\2\n");
1752
1753 hv_store (hv, "desc", sizeof ("desc") - 1,
1754 newSVpvn ("[async_pool]", sizeof ("[async_pool]") - 1), 0);
1755
1756 invoke_av = (AV *)SvRV (invoke);
1757 len = av_len (invoke_av);
1758
1759 sv_setsv (cb, AvARRAY (invoke_av)[0]);
1760
1761 if (len > 0)
1762 {
1763 av_fill (defav, len - 1);
1764 for (i = 0; i < len; ++i)
1765 av_store (defav, i, SvREFCNT_inc (AvARRAY (invoke_av)[i + 1]));
1766 }
1767
485 SvREFCNT_dec (coro->args); 1768 SvREFCNT_dec (invoke);
486 Safefree (coro); 1769}
487 1770
1771void
1772_pool_2 (SV *cb)
1773 CODE:
1774{
1775 struct coro *coro = SvSTATE (coro_current);
488 1776
1777 sv_setsv (cb, &PL_sv_undef);
1778
1779 if (coro_rss (aTHX_ coro) > SvIV (sv_pool_rss)
1780 || av_len (av_async_pool) + 1 >= SvIV (sv_pool_size))
1781 croak ("\3terminate\2\n");
1782
1783 av_clear (GvAV (PL_defgv));
1784 hv_store ((HV *)SvRV (coro_current), "desc", sizeof ("desc") - 1,
1785 newSVpvn ("[async_pool idle]", sizeof ("[async_pool idle]") - 1), 0);
1786
1787 coro->save = CORO_SAVE_DEF;
1788 coro->prio = 0;
1789
1790 if (coro->cctx && (coro->cctx->flags & CC_TRACE))
1791 api_trace (coro_current, 0);
1792
1793 av_push (av_async_pool, newSVsv (coro_current));
1794}
1795
1796
1797MODULE = Coro::State PACKAGE = Coro::AIO
1798
1799SV *
1800_get_state ()
1801 CODE:
1802{
1803 struct io_state *data;
1804
1805 RETVAL = newSV (sizeof (struct io_state));
1806 data = (struct io_state *)SvPVX (RETVAL);
1807 SvCUR_set (RETVAL, sizeof (struct io_state));
1808 SvPOK_only (RETVAL);
1809
1810 data->errorno = errno;
1811 data->laststype = PL_laststype;
1812 data->laststatval = PL_laststatval;
1813 data->statcache = PL_statcache;
1814}
1815 OUTPUT:
1816 RETVAL
1817
1818void
1819_set_state (char *data_)
1820 PROTOTYPE: $
1821 CODE:
1822{
1823 struct io_state *data = (void *)data_;
1824
1825 errno = data->errorno;
1826 PL_laststype = data->laststype;
1827 PL_laststatval = data->laststatval;
1828 PL_statcache = data->statcache;
1829}
1830

Diff Legend

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