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.3 by root, Tue Jul 17 00:24:15 2001 UTC vs.
Revision 1.103 by root, Mon Nov 27 01:33:30 2006 UTC

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

Diff Legend

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