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.102 by root, Mon Nov 27 01:28:03 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 ();
292 550
293 { 551 {
294 dSP; 552 dSP;
295 CV *cv; 553 LOGOP myop;
296 554
297 /* now do the ugly restore mess */ 555 /*PL_curcop = 0;*/
298 while ((cv = (CV *)POPs)) 556 PL_in_eval = 0;
557 SvREFCNT_dec (GvAV (PL_defgv));
558 GvAV (PL_defgv) = coro->args; coro->args = 0;
559
560 SPAGAIN;
561
562 Zero (&myop, 1, LOGOP);
563 myop.op_next = Nullop;
564 myop.op_flags = OPf_WANT_VOID;
565
566 PL_op = (OP *)&myop;
567
568 PUSHMARK (SP);
569 PUSHMARK (SP);
570 XPUSHs ((SV *)get_cv ("Coro::State::coro_init", FALSE));
571 PUTBACK;
572 PL_op = PL_ppaddr[OP_ENTERSUB](aTHX);
573 SPAGAIN;
574
575 ENTER; /* necessary e.g. for dounwind */
576 }
577}
578
579static void
580free_coro_mortal ()
581{
582 if (coro_mortal)
583 {
584 SvREFCNT_dec (coro_mortal);
585 coro_mortal = 0;
586 }
587}
588
589static void NOINLINE
590prepare_cctx (coro_stack *cctx)
591{
592 dSP;
593 LOGOP myop;
594
595 Zero (&myop, 1, LOGOP);
596 myop.op_next = PL_op;
597 myop.op_flags = OPf_WANT_VOID;
598
599 sv_setiv (get_sv ("Coro::State::cctx_stack", FALSE), PTR2IV (cctx));
600
601 PUSHMARK (SP);
602 XPUSHs ((SV *)get_cv ("Coro::State::cctx_init", FALSE));
603 PUTBACK;
604 PL_restartop = PL_ppaddr[OP_ENTERSUB](aTHX);
605 SPAGAIN;
606}
607
608static void
609coro_run (void *arg)
610{
611 /* coro_run is the alternative epilogue of transfer() */
612 UNLOCK;
613
614 /*
615 * this is a _very_ stripped down perl interpreter ;)
616 */
617 PL_top_env = &PL_start_env;
618 /* inject call to cctx_init */
619 prepare_cctx ((coro_stack *)arg);
620
621 /* somebody will hit me for both perl_run and PL_restartop */
622 perl_run (PL_curinterp);
623
624 fputs ("FATAL: C coroutine fell over the edge of the world, aborting.\n", stderr);
625 abort ();
626}
627
628static coro_stack *
629stack_new ()
630{
631 coro_stack *stack;
632
633 New (0, stack, 1, coro_stack);
634
635#if HAVE_MMAP
636
637 stack->ssize = ((STACKSIZE * sizeof (long) + PAGESIZE - 1) / PAGESIZE + STACKGUARD) * PAGESIZE;
638 /* mmap suppsedly does allocate-on-write for us */
639 stack->sptr = mmap (0, stack->ssize, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_PRIVATE|MAP_ANONYMOUS, 0, 0);
640
641 if (stack->sptr == (void *)-1)
642 {
643 perror ("FATAL: unable to mmap stack for coroutine");
644 _exit (EXIT_FAILURE);
645 }
646
647# if STACKGUARD
648 mprotect (stack->sptr, STACKGUARD * PAGESIZE, PROT_NONE);
649# endif
650
651#else
652
653 stack->ssize = STACKSIZE * (long)sizeof (long);
654 New (0, stack->sptr, STACKSIZE, long);
655
656 if (!stack->sptr)
657 {
658 perror (stderr, "FATAL: unable to malloc stack for coroutine");
659 _exit (EXIT_FAILURE);
660 }
661
662#endif
663
664 coro_create (&stack->cctx, coro_run, (void *)stack, stack->sptr, stack->ssize);
665
666 return stack;
667}
668
669static void
670stack_free (coro_stack *stack)
671{
672 if (!stack)
673 return;
674
675#if HAVE_MMAP
676 munmap (stack->sptr, stack->ssize);
677#else
678 Safefree (stack->sptr);
679#endif
680
681 Safefree (stack);
682}
683
684static coro_stack *stack_first;
685static int cctx_count, cctx_idle;
686
687static coro_stack *
688stack_get ()
689{
690 coro_stack *stack;
691
692 if (stack_first)
693 {
694 --cctx_idle;
695 stack = stack_first;
696 stack_first = stack->next;
697 }
698 else
699 {
700 ++cctx_count;
701 stack = stack_new ();
702 PL_op = PL_op->op_next;
703 }
704
705 return stack;
706}
707
708static void
709stack_put (coro_stack *stack)
710{
711 ++cctx_idle;
712 stack->next = stack_first;
713 stack_first = stack;
714}
715
716/* never call directly, always through the coro_state_transfer global variable */
717static void NOINLINE
718transfer (struct coro *prev, struct coro *next, int flags)
719{
720 dSTACKLEVEL;
721
722 /* sometimes transfer is only called to set idle_sp */
723 if (flags == TRANSFER_SET_STACKLEVEL)
724 ((coro_stack *)prev)->idle_sp = STACKLEVEL;
725 else if (prev != next)
726 {
727 coro_stack *prev__stack;
728
729 LOCK;
730
731 if (next->mainstack)
732 {
733 /* coroutine already started */
734 SAVE (prev, flags);
735 LOAD (next);
736 }
737 else
738 {
739 /* need to start coroutine */
740 /* first get rid of the old state */
741 SAVE (prev, -1);
742 /* setup coroutine call */
743 setup_coro (next);
744 /* need a stack */
745 next->stack = 0;
746 }
747
748 if (!prev->stack)
749 /* create a new empty context */
750 Newz (0, prev->stack, 1, coro_stack);
751
752 prev__stack = prev->stack;
753
754 /* possibly "free" the stack */
755 if (prev__stack->idle_sp == STACKLEVEL)
756 {
757 stack_put (prev__stack);
758 prev->stack = 0;
759 }
760
761 if (!next->stack)
762 next->stack = stack_get ();
763
764 if (prev__stack != next->stack)
765 {
766 prev__stack->top_env = PL_top_env;
767 PL_top_env = next->stack->top_env;
768 coro_transfer (&prev__stack->cctx, &next->stack->cctx);
769 }
770
771 free_coro_mortal ();
772
773 UNLOCK;
774 }
775}
776
777struct transfer_args
778{
779 struct coro *prev, *next;
780 int flags;
781};
782
783#define TRANSFER(ta) transfer ((ta).prev, (ta).next, (ta).flags)
784
785static void
786coro_state_destroy (struct coro *coro)
787{
788 if (coro->refcnt--)
789 return;
790
791 if (coro->mainstack && coro->mainstack != main_mainstack)
792 {
793 struct coro temp;
794
795 SAVE ((&temp), TRANSFER_SAVE_ALL);
796 LOAD (coro);
797
798 coro_destroy_stacks ();
799
800 LOAD ((&temp)); /* this will get rid of defsv etc.. */
801
802 coro->mainstack = 0;
803 }
804
805 stack_free (coro->stack);
806 SvREFCNT_dec (coro->args);
807 Safefree (coro);
808}
809
810static int
811coro_state_clear (pTHX_ SV *sv, MAGIC *mg)
812{
813 struct coro *coro = (struct coro *)mg->mg_ptr;
814 mg->mg_ptr = 0;
815
816 coro_state_destroy (coro);
817
818 return 0;
819}
820
821static int
822coro_state_dup (pTHX_ MAGIC *mg, CLONE_PARAMS *params)
823{
824 struct coro *coro = (struct coro *)mg->mg_ptr;
825
826 ++coro->refcnt;
827
828 return 0;
829}
830
831static MGVTBL coro_state_vtbl = {
832 0, 0, 0, 0,
833 coro_state_clear,
834 0,
835#ifdef MGf_DUP
836 coro_state_dup,
837#else
838# define MGf_DUP 0
839#endif
840};
841
842static struct coro *
843SvSTATE (SV *coro)
844{
845 HV *stash;
846 MAGIC *mg;
847
848 if (SvROK (coro))
849 coro = SvRV (coro);
850
851 stash = SvSTASH (coro);
852 if (stash != coro_stash && stash != coro_state_stash)
853 {
854 /* very slow, but rare, check */
855 if (!sv_derived_from (sv_2mortal (newRV_inc (coro)), "Coro::State"))
856 croak ("Coro::State object required");
857 }
858
859 mg = SvMAGIC (coro);
860 assert (mg->mg_type == PERL_MAGIC_ext);
861 return (struct coro *)mg->mg_ptr;
862}
863
864static void
865prepare_transfer (struct transfer_args *ta, SV *prev, SV *next, int flags)
866{
867 ta->prev = SvSTATE (prev);
868 ta->next = SvSTATE (next);
869 ta->flags = flags;
870}
871
872static void
873api_transfer (SV *prev, SV *next, int flags)
874{
875 dTHX;
876 struct transfer_args ta;
877
878 prepare_transfer (&ta, prev, next, flags);
879 TRANSFER (ta);
880}
881
882/** Coro ********************************************************************/
883
884#define PRIO_MAX 3
885#define PRIO_HIGH 1
886#define PRIO_NORMAL 0
887#define PRIO_LOW -1
888#define PRIO_IDLE -3
889#define PRIO_MIN -4
890
891/* for Coro.pm */
892static GV *coro_current, *coro_idle;
893static AV *coro_ready [PRIO_MAX-PRIO_MIN+1];
894static int coro_nready;
895
896static void
897coro_enq (SV *sv)
898{
899 int prio;
900
901 if (SvTYPE (sv) != SVt_PVHV)
902 croak ("Coro::ready tried to enqueue something that is not a coroutine");
903
904 prio = SvSTATE (sv)->prio;
905
906 av_push (coro_ready [prio - PRIO_MIN], sv);
907 coro_nready++;
908}
909
910static SV *
911coro_deq (int min_prio)
912{
913 int prio = PRIO_MAX - PRIO_MIN;
914
915 min_prio -= PRIO_MIN;
916 if (min_prio < 0)
917 min_prio = 0;
918
919 for (prio = PRIO_MAX - PRIO_MIN + 1; --prio >= min_prio; )
920 if (AvFILLp (coro_ready [prio]) >= 0)
299 { 921 {
300 AV *padlist = (AV *)POPs; 922 coro_nready--;
301 923 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 } 924 }
311 925
926 return 0;
927}
928
929static void
930api_ready (SV *coro)
931{
932 dTHX;
933
934 if (SvROK (coro))
935 coro = SvRV (coro);
936
937 LOCK;
938 coro_enq (SvREFCNT_inc (coro));
939 UNLOCK;
940}
941
942static void
943prepare_schedule (struct transfer_args *ta)
944{
945 SV *current, *prev, *next;
946
947 current = GvSV (coro_current);
948
949 for (;;)
950 {
951 LOCK;
952 next = coro_deq (PRIO_MIN);
953 UNLOCK;
954
955 if (next)
956 break;
957
958 {
959 dSP;
960
961 ENTER;
962 SAVETMPS;
963
964 PUSHMARK (SP);
312 PUTBACK; 965 PUTBACK;
313 } 966 call_sv (GvSV (coro_idle), G_DISCARD);
314}
315 967
316/* this is an EXACT copy of S_nuke_stacks in perl.c, which is unfortunately static */ 968 FREETMPS;
317STATIC void 969 LEAVE;
318S_nuke_stacks(pTHX) 970 }
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 } 971 }
329 Safefree(PL_tmps_stack);
330 Safefree(PL_markstack);
331 Safefree(PL_scopestack);
332 Safefree(PL_savestack);
333 Safefree(PL_retstack);
334}
335 972
336#define SUB_INIT "Coro::State::_newcoro" 973 prev = SvRV (current);
974 SvRV (current) = next;
975
976 /* free this only after the transfer */
977 LOCK;
978 free_coro_mortal ();
979 UNLOCK;
980 coro_mortal = prev;
981
982 ta->prev = SvSTATE (prev);
983 ta->next = SvSTATE (next);
984 ta->flags = TRANSFER_SAVE_ALL;
985}
986
987static void
988prepare_cede (struct transfer_args *ta)
989{
990 LOCK;
991 coro_enq (SvREFCNT_inc (SvRV (GvSV (coro_current))));
992 UNLOCK;
993
994 prepare_schedule (ta);
995}
996
997static void
998api_schedule (void)
999{
1000 dTHX;
1001 struct transfer_args ta;
1002
1003 prepare_schedule (&ta);
1004 TRANSFER (ta);
1005}
1006
1007static void
1008api_cede (void)
1009{
1010 dTHX;
1011 struct transfer_args ta;
1012
1013 prepare_cede (&ta);
1014 TRANSFER (ta);
1015}
337 1016
338MODULE = Coro::State PACKAGE = Coro::State 1017MODULE = Coro::State PACKAGE = Coro::State
339 1018
340PROTOTYPES: ENABLE 1019PROTOTYPES: DISABLE
341 1020
342BOOT: 1021BOOT:
343 if (!padlist_cache) 1022{
344 padlist_cache = newHV (); 1023#ifdef USE_ITHREADS
1024 MUTEX_INIT (&coro_mutex);
1025#endif
1026 BOOT_PAGESIZE;
345 1027
346Coro::State 1028 coro_state_stash = gv_stashpv ("Coro::State", TRUE);
347_newprocess(args) 1029
348 SV * args 1030 newCONSTSUB (coro_state_stash, "SAVE_DEFAV", newSViv (TRANSFER_SAVE_DEFAV));
349 PROTOTYPE: $ 1031 newCONSTSUB (coro_state_stash, "SAVE_DEFSV", newSViv (TRANSFER_SAVE_DEFSV));
1032 newCONSTSUB (coro_state_stash, "SAVE_ERRSV", newSViv (TRANSFER_SAVE_ERRSV));
1033
1034 main_mainstack = PL_mainstack;
1035
1036 coroapi.ver = CORO_API_VERSION;
1037 coroapi.transfer = api_transfer;
1038
1039 assert (("PRIO_NORMAL must be 0", !PRIO_NORMAL));
1040}
1041
1042SV *
1043new (char *klass, ...)
350 CODE: 1044 CODE:
351 Coro__State coro; 1045{
1046 struct coro *coro;
1047 HV *hv;
1048 int i;
352 1049
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); 1050 Newz (0, coro, 1, struct coro);
1051 coro->args = newAV ();
357 1052
1053 hv = newHV ();
1054 sv_magicext ((SV *)hv, 0, PERL_MAGIC_ext, &coro_state_vtbl, (char *)coro, 0)->mg_flags |= MGf_DUP;
1055 RETVAL = sv_bless (newRV_noinc ((SV *)hv), gv_stashpv (klass, 1));
1056
1057 for (i = 1; i < items; i++)
1058 av_push (coro->args, newSVsv (ST (i)));
1059
358 coro->mainstack = 0; /* actual work is done inside transfer */ 1060 /*coro->mainstack = 0; *//*actual work is done inside transfer */
359 coro->args = (AV *)SvREFCNT_inc (SvRV (args)); 1061 /*coro->stack = 0;*/
360 1062}
361 RETVAL = coro;
362 OUTPUT: 1063 OUTPUT:
363 RETVAL 1064 RETVAL
364 1065
365void 1066void
366transfer(prev,next) 1067_set_stacklevel (...)
367 Coro::State_or_hashref prev 1068 ALIAS:
368 Coro::State_or_hashref next 1069 Coro::State::transfer = 1
1070 Coro::schedule = 2
1071 Coro::cede = 3
1072 Coro::Cont::yield = 4
369 CODE: 1073 CODE:
1074{
1075 struct transfer_args ta;
370 1076
371 if (prev != next) 1077 switch (ix)
372 { 1078 {
373 PUTBACK; 1079 case 0:
374 SAVE (aTHX_ prev); 1080 ta.prev = (struct coro *)INT2PTR (coro_stack *, SvIV (ST (0)));
1081 ta.next = 0;
1082 ta.flags = TRANSFER_SET_STACKLEVEL;
1083 break;
375 1084
376 /* 1085 case 1:
377 * this could be done in newprocess which would lead to 1086 if (items != 3)
378 * extremely elegant and fast (just PUTBACK/SAVE/LOAD/SPAGAIN) 1087 croak ("Coro::State::transfer(prev,next,flags) expects three arguments, not %d", items);
379 * code here, but lazy allocation of stacks has also 1088
380 * some virtues and the overhead of the if() is nil. 1089 prepare_transfer (&ta, ST (0), ST (1), SvIV (ST (2)));
381 */ 1090 break;
382 if (next->mainstack) 1091
1092 case 2:
1093 prepare_schedule (&ta);
1094 break;
1095
1096 case 3:
1097 prepare_cede (&ta);
1098 break;
1099
1100 case 4:
383 { 1101 {
384 LOAD (aTHX_ next); 1102 SV *yieldstack;
385 next->mainstack = 0; /* unnecessary but much cleaner */ 1103 SV *sv;
1104 AV *defav = GvAV (PL_defgv);
1105
1106 yieldstack = *hv_fetch (
1107 (HV *)SvRV (GvSV (coro_current)),
1108 "yieldstack", sizeof ("yieldstack") - 1,
1109 0
386 SPAGAIN; 1110 );
1111
1112 /* set up @_ -- ugly */
1113 av_clear (defav);
1114 av_fill (defav, items - 1);
1115 while (items--)
1116 av_store (defav, items, SvREFCNT_inc (ST(items)));
1117
1118 sv = av_pop ((AV *)SvRV (yieldstack));
1119 ta.prev = SvSTATE (*av_fetch ((AV *)SvRV (sv), 0, 0));
1120 ta.next = SvSTATE (*av_fetch ((AV *)SvRV (sv), 1, 0));
1121 ta.flags = 0;
1122 SvREFCNT_dec (sv);
387 } 1123 }
388 else 1124 break;
389 {
390 /*
391 * emulate part of the perl startup here.
392 */
393 UNOP myop;
394 1125
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 } 1126 }
420 1127
1128 TRANSFER (ta);
1129}
1130
421void 1131void
422DESTROY(coro) 1132_clone_state_from (SV *dst, SV *src)
423 Coro::State coro 1133 CODE:
1134{
1135 struct coro *coro_src = SvSTATE (src);
1136
1137 sv_unmagic (SvRV (dst), PERL_MAGIC_ext);
1138
1139 ++coro_src->refcnt;
1140 sv_magicext (SvRV (dst), 0, PERL_MAGIC_ext, &coro_state_vtbl, (char *)coro_src, 0)->mg_flags |= MGf_DUP;
1141}
1142
1143void
1144_exit (code)
1145 int code
1146 PROTOTYPE: $
1147 CODE:
1148 _exit (code);
1149
1150MODULE = Coro::State PACKAGE = Coro
1151
1152BOOT:
1153{
1154 int i;
1155
1156 coro_stash = gv_stashpv ("Coro", TRUE);
1157
1158 newCONSTSUB (coro_stash, "PRIO_MAX", newSViv (PRIO_MAX));
1159 newCONSTSUB (coro_stash, "PRIO_HIGH", newSViv (PRIO_HIGH));
1160 newCONSTSUB (coro_stash, "PRIO_NORMAL", newSViv (PRIO_NORMAL));
1161 newCONSTSUB (coro_stash, "PRIO_LOW", newSViv (PRIO_LOW));
1162 newCONSTSUB (coro_stash, "PRIO_IDLE", newSViv (PRIO_IDLE));
1163 newCONSTSUB (coro_stash, "PRIO_MIN", newSViv (PRIO_MIN));
1164
1165 coro_current = gv_fetchpv ("Coro::current", TRUE, SVt_PV);
1166 coro_idle = gv_fetchpv ("Coro::idle" , TRUE, SVt_PV);
1167
1168 for (i = PRIO_MAX - PRIO_MIN + 1; i--; )
1169 coro_ready[i] = newAV ();
1170
1171 {
1172 SV *sv = perl_get_sv("Coro::API", 1);
1173
1174 coroapi.schedule = api_schedule;
1175 coroapi.cede = api_cede;
1176 coroapi.ready = api_ready;
1177 coroapi.nready = &coro_nready;
1178 coroapi.current = coro_current;
1179
1180 GCoroAPI = &coroapi;
1181 sv_setiv (sv, (IV)&coroapi);
1182 SvREADONLY_on (sv);
1183 }
1184}
1185
1186int
1187prio (Coro::State coro, int newprio = 0)
1188 ALIAS:
1189 nice = 1
424 CODE: 1190 CODE:
1191{
1192 RETVAL = coro->prio;
425 1193
426 if (coro->mainstack) 1194 if (items > 1)
427 { 1195 {
428 struct coro temp; 1196 if (ix)
1197 newprio += coro->prio;
429 1198
430 PUTBACK; 1199 if (newprio < PRIO_MIN) newprio = PRIO_MIN;
431 SAVE(aTHX_ (&temp)); 1200 if (newprio > PRIO_MAX) newprio = PRIO_MAX;
432 LOAD(aTHX_ coro);
433 1201
434 S_nuke_stacks (); 1202 coro->prio = newprio;
435 SvREFCNT_dec ((SV *)GvAV (PL_defgv));
436
437 LOAD((&temp));
438 SPAGAIN;
439 } 1203 }
1204}
440 1205
441 SvREFCNT_dec (coro->args); 1206void
442 Safefree (coro); 1207ready (SV *self)
1208 PROTOTYPE: $
1209 CODE:
1210 api_ready (self);
443 1211
1212int
1213nready (...)
1214 PROTOTYPE:
1215 CODE:
1216 RETVAL = coro_nready;
1217 OUTPUT:
1218 RETVAL
444 1219
1220MODULE = Coro::State PACKAGE = Coro::AIO
1221
1222SV *
1223_get_state ()
1224 CODE:
1225{
1226 struct {
1227 int errorno;
1228 int laststype;
1229 int laststatval;
1230 Stat_t statcache;
1231 } data;
1232
1233 data.errorno = errno;
1234 data.laststype = PL_laststype;
1235 data.laststatval = PL_laststatval;
1236 data.statcache = PL_statcache;
1237
1238 RETVAL = newSVpvn ((char *)&data, sizeof data);
1239}
1240 OUTPUT:
1241 RETVAL
1242
1243void
1244_set_state (char *data_)
1245 PROTOTYPE: $
1246 CODE:
1247{
1248 struct {
1249 int errorno;
1250 int laststype;
1251 int laststatval;
1252 Stat_t statcache;
1253 } *data = (void *)data_;
1254
1255 errno = data->errorno;
1256 PL_laststype = data->laststype;
1257 PL_laststatval = data->laststatval;
1258 PL_statcache = data->statcache;
1259}

Diff Legend

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