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.2 by root, Sun Jul 15 02:35:52 2001 UTC vs.
Revision 1.10 by root, Sat Jul 21 04:19:34 2001 UTC

1#include "EXTERN.h" 1#include "EXTERN.h"
2#include "perl.h" 2#include "perl.h"
3#include "XSUB.h" 3#include "XSUB.h"
4 4
5#if 1
6# define CHK(x) (void *)0
7#else
8# define CHK(x) if (!(x)) croak("FATAL, CHK: " #x)
9#endif
10
11#define MAY_FLUSH /* increases codesize */
12
13#define SUB_INIT "Coro::State::coroutine_initialization"
14
15#define SAVE_DEFAV 0x00000001
16#define SAVE_DEFSV 0x00000002
17#define SAVE_ERRSV 0x00000004
18
19#define SAVE_ALL -1
20
5struct coro { 21struct coro {
22 /* optionally saved, might be zero */
23 AV *defav;
24 SV *defsv;
25 SV *errsv;
26
27 /* saved global state not related to stacks */
6 U8 dowarn; 28 U8 dowarn;
7 29
30 /* the stacks and related info (callchain etc..) */
8 PERL_SI *curstackinfo; 31 PERL_SI *curstackinfo;
9 AV *curstack; 32 AV *curstack;
10 AV *mainstack; 33 AV *mainstack;
11 SV **stack_sp; 34 SV **stack_sp;
12 OP *op; 35 OP *op;
… …
29 OP **retstack; 52 OP **retstack;
30 I32 retstack_ix; 53 I32 retstack_ix;
31 I32 retstack_max; 54 I32 retstack_max;
32 COP *curcop; 55 COP *curcop;
33 56
34 AV *defav; 57 /* data associated with this coroutine (initial args) */
35 58 AV *args;
36 SV *proc;
37}; 59};
38 60
39typedef struct coro *Coro__State; 61typedef struct coro *Coro__State;
40typedef struct coro *Coro__State_or_hashref; 62typedef struct coro *Coro__State_or_hashref;
41 63
42#define SAVE(c) \ 64static HV *padlist_cache;
43 c->dowarn = PL_dowarn; \
44 c->curstackinfo = PL_curstackinfo; \
45 c->curstack = PL_curstack; \
46 c->mainstack = PL_mainstack; \
47 c->stack_sp = PL_stack_sp; \
48 c->op = PL_op; \
49 c->curpad = PL_curpad; \
50 c->stack_base = PL_stack_base; \
51 c->stack_max = PL_stack_max; \
52 c->tmps_stack = PL_tmps_stack; \
53 c->tmps_floor = PL_tmps_floor; \
54 c->tmps_ix = PL_tmps_ix; \
55 c->tmps_max = PL_tmps_max; \
56 c->markstack = PL_markstack; \
57 c->markstack_ptr = PL_markstack_ptr; \
58 c->markstack_max = PL_markstack_max; \
59 c->scopestack = PL_scopestack; \
60 c->scopestack_ix = PL_scopestack_ix; \
61 c->scopestack_max = PL_scopestack_max;\
62 c->savestack = PL_savestack; \
63 c->savestack_ix = PL_savestack_ix; \
64 c->savestack_max = PL_savestack_max; \
65 c->retstack = PL_retstack; \
66 c->retstack_ix = PL_retstack_ix; \
67 c->retstack_max = PL_retstack_max; \
68 c->curcop = PL_curcop; \
69 c->defav = GvAV (PL_defgv);
70 65
71#define LOAD(c) \ 66/* mostly copied from op.c:cv_clone2 */
72 PL_dowarn = c->dowarn; \ 67STATIC AV *
73 PL_curstackinfo = c->curstackinfo; \ 68clone_padlist (AV *protopadlist)
74 PL_curstack = c->curstack; \ 69{
75 PL_mainstack = c->mainstack; \ 70 AV *av;
76 PL_stack_sp = c->stack_sp; \ 71 I32 ix;
77 PL_op = c->op; \ 72 AV *protopad_name = (AV *) * av_fetch (protopadlist, 0, FALSE);
78 PL_curpad = c->curpad; \ 73 AV *protopad = (AV *) * av_fetch (protopadlist, 1, FALSE);
79 PL_stack_base = c->stack_base; \ 74 SV **pname = AvARRAY (protopad_name);
80 PL_stack_max = c->stack_max; \ 75 SV **ppad = AvARRAY (protopad);
81 PL_tmps_stack = c->tmps_stack; \ 76 I32 fname = AvFILLp (protopad_name);
82 PL_tmps_floor = c->tmps_floor; \ 77 I32 fpad = AvFILLp (protopad);
83 PL_tmps_ix = c->tmps_ix; \ 78 AV *newpadlist, *newpad_name, *newpad;
84 PL_tmps_max = c->tmps_max; \ 79 SV **npad;
85 PL_markstack = c->markstack; \
86 PL_markstack_ptr = c->markstack_ptr; \
87 PL_markstack_max = c->markstack_max; \
88 PL_scopestack = c->scopestack; \
89 PL_scopestack_ix = c->scopestack_ix; \
90 PL_scopestack_max = c->scopestack_max;\
91 PL_savestack = c->savestack; \
92 PL_savestack_ix = c->savestack_ix; \
93 PL_savestack_max = c->savestack_max; \
94 PL_retstack = c->retstack; \
95 PL_retstack_ix = c->retstack_ix; \
96 PL_retstack_max = c->retstack_max; \
97 PL_curcop = c->curcop; \
98 GvAV (PL_defgv) = c->defav;
99 80
100/* this is an EXACT copy of S_nuke_stacks in perl.c, which is unfortunately static */ 81 newpad_name = newAV ();
82 for (ix = fname; ix >= 0; ix--)
83 av_store (newpad_name, ix, SvREFCNT_inc (pname[ix]));
84
85 newpad = newAV ();
86 av_fill (newpad, AvFILLp (protopad));
87 npad = AvARRAY (newpad);
88
89 newpadlist = newAV ();
90 AvREAL_off (newpadlist);
91 av_store (newpadlist, 0, (SV *) newpad_name);
92 av_store (newpadlist, 1, (SV *) newpad);
93
94 av = newAV (); /* will be @_ */
95 av_extend (av, 0);
96 av_store (newpad, 0, (SV *) av);
97 AvFLAGS (av) = AVf_REIFY;
98
99 for (ix = fpad; ix > 0; ix--)
100 {
101 SV *namesv = (ix <= fname) ? pname[ix] : Nullsv;
102 if (namesv && namesv != &PL_sv_undef)
103 {
104 char *name = SvPVX (namesv); /* XXX */
105 if (SvFLAGS (namesv) & SVf_FAKE || *name == '&')
106 { /* lexical from outside? */
107 npad[ix] = SvREFCNT_inc (ppad[ix]);
108 }
109 else
110 { /* our own lexical */
111 SV *sv;
112 if (*name == '&')
113 sv = SvREFCNT_inc (ppad[ix]);
114 else if (*name == '@')
115 sv = (SV *) newAV ();
116 else if (*name == '%')
117 sv = (SV *) newHV ();
118 else
119 sv = NEWSV (0, 0);
120 if (!SvPADBUSY (sv))
121 SvPADMY_on (sv);
122 npad[ix] = sv;
123 }
124 }
125 else if (IS_PADGV (ppad[ix]) || IS_PADCONST (ppad[ix]))
126 {
127 npad[ix] = SvREFCNT_inc (ppad[ix]);
128 }
129 else
130 {
131 SV *sv = NEWSV (0, 0);
132 SvPADTMP_on (sv);
133 npad[ix] = sv;
134 }
135 }
136
137#if 0 /* return -ENOTUNDERSTOOD */
138 /* Now that vars are all in place, clone nested closures. */
139
140 for (ix = fpad; ix > 0; ix--) {
141 SV* namesv = (ix <= fname) ? pname[ix] : Nullsv;
142 if (namesv
143 && namesv != &PL_sv_undef
144 && !(SvFLAGS(namesv) & SVf_FAKE)
145 && *SvPVX(namesv) == '&'
146 && CvCLONE(ppad[ix]))
147 {
148 CV *kid = cv_clone((CV*)ppad[ix]);
149 SvREFCNT_dec(ppad[ix]);
150 CvCLONE_on(kid);
151 SvPADMY_on(kid);
152 npad[ix] = (SV*)kid;
153 }
154 }
155#endif
156
157 return newpadlist;
158}
159
160#ifdef MAY_FLUSH
161STATIC AV *
162free_padlist (AV *padlist)
163{
164 /* may be during global destruction */
165 if (SvREFCNT(padlist))
166 {
167 I32 i = AvFILLp(padlist);
168 while (i >= 0)
169 {
170 SV **svp = av_fetch(padlist, i--, FALSE);
171 SV *sv = svp ? *svp : Nullsv;
172 if (sv)
173 SvREFCNT_dec(sv);
174 }
175
176 SvREFCNT_dec((SV*)padlist);
177 }
178}
179#endif
180
181/* the next two functions merely cache the padlists */
101STATIC void 182STATIC void
102S_nuke_stacks(pTHX) 183get_padlist (CV *cv)
103{ 184{
104 while (PL_curstackinfo->si_next) 185 SV **he = hv_fetch (padlist_cache, (void *)&cv, sizeof (CV *), 0);
105 PL_curstackinfo = PL_curstackinfo->si_next; 186
106 while (PL_curstackinfo) { 187 if (he && AvFILLp ((AV *)*he) >= 0)
107 PERL_SI *p = PL_curstackinfo->si_prev; 188 CvPADLIST (cv) = (AV *)av_pop ((AV *)*he);
108 /* curstackinfo->si_stack got nuked by sv_free_arenas() */ 189 else
109 Safefree(PL_curstackinfo->si_cxstack); 190 CvPADLIST (cv) = clone_padlist (CvPADLIST (cv));
110 Safefree(PL_curstackinfo); 191}
111 PL_curstackinfo = p; 192
193STATIC void
194put_padlist (CV *cv)
195{
196 SV **he = hv_fetch (padlist_cache, (void *)&cv, sizeof (CV *), 1);
197
198 if (SvTYPE (*he) != SVt_PVAV)
199 {
200 SvREFCNT_dec (*he);
201 *he = (SV *)newAV ();
112 } 202 }
203
204 av_push ((AV *)*he, (SV *)CvPADLIST (cv));
205}
206
207#ifdef MAY_FLUSH
208STATIC void
209flush_padlist_cache ()
210{
211 HV *hv = padlist_cache;
212 padlist_cache = newHV ();
213
214 if (hv_iterinit (hv))
215 {
216 HE *he;
217 AV *padlist;
218
219 while (!!(he = hv_iternext (hv)))
220 {
221 AV *av = (AV *)HeVAL(he);
222
223 /* casting is fun. */
224 while (&PL_sv_undef != (SV *)(padlist = (AV *)av_pop (av)))
225 free_padlist (padlist);
226 }
227 }
228
229 SvREFCNT_dec (hv);
230}
231#endif
232
233#define SB do {
234#define SE } while (0)
235
236#define LOAD(state) SB load_state(aTHX_ state); SPAGAIN; SE
237#define SAVE(state,flags) SB PUTBACK; save_state(aTHX_ state,flags); SE
238
239#define REPLACE_SV(sv,val) SB SvREFCNT_dec(sv); (sv) = (val); SE
240
241static void
242load_state(pTHX_ Coro__State c)
243{
244 PL_dowarn = c->dowarn;
245
246 PL_curstackinfo = c->curstackinfo;
247 PL_curstack = c->curstack;
248 PL_mainstack = c->mainstack;
249 PL_stack_sp = c->stack_sp;
250 PL_op = c->op;
251 PL_curpad = c->curpad;
252 PL_stack_base = c->stack_base;
253 PL_stack_max = c->stack_max;
254 PL_tmps_stack = c->tmps_stack;
255 PL_tmps_floor = c->tmps_floor;
256 PL_tmps_ix = c->tmps_ix;
257 PL_tmps_max = c->tmps_max;
258 PL_markstack = c->markstack;
259 PL_markstack_ptr = c->markstack_ptr;
260 PL_markstack_max = c->markstack_max;
261 PL_scopestack = c->scopestack;
262 PL_scopestack_ix = c->scopestack_ix;
263 PL_scopestack_max = c->scopestack_max;
264 PL_savestack = c->savestack;
265 PL_savestack_ix = c->savestack_ix;
266 PL_savestack_max = c->savestack_max;
267 PL_retstack = c->retstack;
268 PL_retstack_ix = c->retstack_ix;
269 PL_retstack_max = c->retstack_max;
270 PL_curcop = c->curcop;
271
272 if (c->defav) REPLACE_SV (GvAV (PL_defgv), c->defav);
273 if (c->defsv) REPLACE_SV (DEFSV , c->defsv);
274 if (c->errsv) REPLACE_SV (ERRSV , c->errsv);
275
276 {
277 dSP;
278 CV *cv;
279
280 /* now do the ugly restore mess */
281 while ((cv = (CV *)POPs))
282 {
283 AV *padlist = (AV *)POPs;
284
285 if (padlist)
286 {
287 put_padlist (cv); /* mark this padlist as available */
288 CvPADLIST(cv) = padlist;
289#ifdef USE_THREADS
290 /*CvOWNER(cv) = (struct perl_thread *)POPs;*/
291#endif
292 }
293
294 ++CvDEPTH(cv);
295 }
296
297 PUTBACK;
298 }
299}
300
301static void
302save_state(pTHX_ Coro__State c, int flags)
303{
304 {
305 dSP;
306 I32 cxix = cxstack_ix;
307 PERL_SI *top_si = PL_curstackinfo;
308 PERL_CONTEXT *ccstk = cxstack;
309
310 /*
311 * the worst thing you can imagine happens first - we have to save
312 * (and reinitialize) all cv's in the whole callchain :(
313 */
314
315 PUSHs (Nullsv);
316 /* this loop was inspired by pp_caller */
317 for (;;)
318 {
319 do
320 {
321 PERL_CONTEXT *cx = &ccstk[cxix--];
322
323 if (CxTYPE(cx) == CXt_SUB)
324 {
325 CV *cv = cx->blk_sub.cv;
326 if (CvDEPTH(cv))
327 {
328#ifdef USE_THREADS
329 /*XPUSHs ((SV *)CvOWNER(cv));*/
330 /*CvOWNER(cv) = 0;*/
331 /*error must unlock this cv etc.. etc...*/
332#endif
333 EXTEND (SP, CvDEPTH(cv)*2);
334
335 while (--CvDEPTH(cv))
336 {
337 /* this tells the restore code to increment CvDEPTH */
338 PUSHs (Nullsv);
339 PUSHs ((SV *)cv);
340 }
341
342 PUSHs ((SV *)CvPADLIST(cv));
343 PUSHs ((SV *)cv);
344
345 get_padlist (cv); /* this is a monster */
346 }
347 }
348 else if (CxTYPE(cx) == CXt_FORMAT)
349 {
350 /* I never used formats, so how should I know how these are implemented? */
351 /* my bold guess is as a simple, plain sub... */
352 croak ("CXt_FORMAT not yet handled. Don't switch coroutines from within formats");
353 }
354 }
355 while (cxix >= 0);
356
357 if (top_si->si_type == PERLSI_MAIN)
358 break;
359
360 top_si = top_si->si_prev;
361 ccstk = top_si->si_cxstack;
362 cxix = top_si->si_cxix;
363 }
364
365 PUTBACK;
366 }
367
368 c->defav = flags & SAVE_DEFAV ? (AV *)SvREFCNT_inc (GvAV (PL_defgv)) : 0;
369 c->defsv = flags & SAVE_DEFSV ? SvREFCNT_inc (DEFSV) : 0;
370 c->errsv = flags & SAVE_ERRSV ? SvREFCNT_inc (ERRSV) : 0;
371
372 c->dowarn = PL_dowarn;
373
374 c->curstackinfo = PL_curstackinfo;
375 c->curstack = PL_curstack;
376 c->mainstack = PL_mainstack;
377 c->stack_sp = PL_stack_sp;
378 c->op = PL_op;
379 c->curpad = PL_curpad;
380 c->stack_base = PL_stack_base;
381 c->stack_max = PL_stack_max;
382 c->tmps_stack = PL_tmps_stack;
383 c->tmps_floor = PL_tmps_floor;
384 c->tmps_ix = PL_tmps_ix;
385 c->tmps_max = PL_tmps_max;
386 c->markstack = PL_markstack;
387 c->markstack_ptr = PL_markstack_ptr;
388 c->markstack_max = PL_markstack_max;
389 c->scopestack = PL_scopestack;
390 c->scopestack_ix = PL_scopestack_ix;
391 c->scopestack_max = PL_scopestack_max;
392 c->savestack = PL_savestack;
393 c->savestack_ix = PL_savestack_ix;
394 c->savestack_max = PL_savestack_max;
395 c->retstack = PL_retstack;
396 c->retstack_ix = PL_retstack_ix;
397 c->retstack_max = PL_retstack_max;
398 c->curcop = PL_curcop;
399}
400
401/*
402 * destroy the stacks, the callchain etc...
403 * still there is a memleak of 128 bytes...
404 */
405STATIC void
406destroy_stacks(pTHX)
407{
408 /* is this ugly, I ask? */
409 while (PL_scopestack_ix)
410 LEAVE;
411
412 /* sure it is, but more important: is it correct?? :/ */
413 while (PL_tmps_ix > PL_tmps_floor) /* should only ever be one iteration */
414 FREETMPS;
415
416 while (PL_curstackinfo->si_next)
417 PL_curstackinfo = PL_curstackinfo->si_next;
418
419 while (PL_curstackinfo)
420 {
421 PERL_SI *p = PL_curstackinfo->si_prev;
422
423 {
424 dSP;
425 SWITCHSTACK (PL_curstack, PL_curstackinfo->si_stack);
426 PUTBACK; /* possibly superfluous */
427 }
428
429 dounwind(-1);
430
431 SvREFCNT_dec(PL_curstackinfo->si_stack);
432 Safefree(PL_curstackinfo->si_cxstack);
433 Safefree(PL_curstackinfo);
434 PL_curstackinfo = p;
435 }
436
113 Safefree(PL_tmps_stack); 437 Safefree(PL_tmps_stack);
114 Safefree(PL_markstack); 438 Safefree(PL_markstack);
115 Safefree(PL_scopestack); 439 Safefree(PL_scopestack);
116 Safefree(PL_savestack); 440 Safefree(PL_savestack);
117 Safefree(PL_retstack); 441 Safefree(PL_retstack);
118} 442}
119 443
444STATIC void
445transfer(pTHX_ struct coro *prev, struct coro *next, int flags)
446{
447 dSP;
448
449 if (prev != next)
450 {
451 /*
452 * this could be done in newprocess which would lead to
453 * extremely elegant and fast (just SAVE/LOAD)
454 * code here, but lazy allocation of stacks has also
455 * some virtues and the overhead of the if() is nil.
456 */
457 if (next->mainstack)
458 {
459 SAVE (prev, flags);
460 LOAD (next);
461 /* mark this state as in-use */
462 next->mainstack = 0;
463 next->tmps_ix = -2;
464 }
465 else if (next->tmps_ix == -2)
466 {
467 croak ("tried to transfer to running coroutine");
468 }
469 else
470 {
471 /*
472 * emulate part of the perl startup here.
473 */
474 UNOP myop;
475
476 SAVE (prev, -1); /* first get rid of the old state */
477
478 init_stacks (); /* from perl.c */
479 SPAGAIN;
480
481 PL_op = (OP *)&myop;
482 /*PL_curcop = 0;*/
483 SvREFCNT_dec (GvAV (PL_defgv));
484 GvAV (PL_defgv) = next->args;
485
486 Zero(&myop, 1, UNOP);
487 myop.op_next = Nullop;
488 myop.op_flags = OPf_WANT_VOID;
489
490 PUSHMARK(SP);
491 XPUSHs ((SV*)get_cv(SUB_INIT, TRUE));
492 /*
493 * the next line is slightly wrong, as PL_op->op_next
494 * is actually being executed so we skip the first op.
495 * that doesn't matter, though, since it is only
496 * pp_nextstate and we never return...
497 * ah yes, and I don't care anyways ;)
498 */
499 PUTBACK;
500 PL_op = pp_entersub(aTHX);
501 SPAGAIN;
502
503 ENTER; /* necessary e.g. for dounwind */
504 }
505 }
506}
507
120MODULE = Coro::State PACKAGE = Coro::State 508MODULE = Coro::State PACKAGE = Coro::State
121 509
122PROTOTYPES: ENABLE 510PROTOTYPES: ENABLE
123 511
512BOOT:
513{ /* {} necessary for stoopid perl-5.6.x */
514 HV * stash = gv_stashpvn("Coro::State", 10, TRUE);
515
516 newCONSTSUB (stash, "SAVE_DEFAV", newSViv (SAVE_DEFAV));
517 newCONSTSUB (stash, "SAVE_DEFSV", newSViv (SAVE_DEFSV));
518 newCONSTSUB (stash, "SAVE_ERRSV", newSViv (SAVE_ERRSV));
519
520 if (!padlist_cache)
521 padlist_cache = newHV ();
522}
523
124Coro::State 524Coro::State
125newprocess(proc) 525_newprocess(args)
126 SV * proc 526 SV * args
127 PROTOTYPE: & 527 PROTOTYPE: $
128 CODE: 528 CODE:
129 Coro__State coro; 529 Coro__State coro;
530
531 if (!SvROK (args) || SvTYPE (SvRV (args)) != SVt_PVAV)
532 croak ("Coro::State::_newprocess expects an arrayref");
130 533
131 New (0, coro, 1, struct coro); 534 New (0, coro, 1, struct coro);
132 535
133 coro->mainstack = 0; /* actual work is done inside transfer */ 536 coro->mainstack = 0; /* actual work is done inside transfer */
134 coro->proc = SvREFCNT_inc (proc); 537 coro->args = (AV *)SvREFCNT_inc (SvRV (args));
135 538
136 RETVAL = coro; 539 RETVAL = coro;
137 OUTPUT: 540 OUTPUT:
138 RETVAL 541 RETVAL
139 542
140void 543void
141transfer(prev,next) 544transfer(prev, next, flags = SAVE_DEFAV)
142 Coro::State_or_hashref prev 545 Coro::State_or_hashref prev
143 Coro::State_or_hashref next 546 Coro::State_or_hashref next
547 int flags
548 PROTOTYPE: @
144 CODE: 549 CODE:
145 550
146 if (prev != next) 551 transfer (aTHX_ prev, next, flags);
147 {
148 PUTBACK;
149 SAVE (prev);
150
151 /*
152 * this could be done in newprocess which would to
153 * extremely elegant and fast (just PUTBACK/SAVE/LOAD/SPAGAIN)
154 * code here, but lazy allocation of stacks has also
155 * some virtues and the overhead of the if() is nil.
156 */
157 if (next->mainstack)
158 {
159 LOAD (next);
160 next->mainstack = 0; /* unnecessary but much cleaner */
161 SPAGAIN;
162 }
163 else
164 {
165 /*
166 * emulate part of the perl startup here.
167 */
168 UNOP myop;
169
170 init_stacks ();
171 PL_op = (OP *)&myop;
172 /*PL_curcop = 0;*/
173 GvAV (PL_defgv) = newAV ();
174
175 SPAGAIN;
176 Zero(&myop, 1, UNOP);
177 myop.op_next = Nullop;
178 myop.op_flags = OPf_WANT_VOID;
179
180 EXTEND (SP,1);
181 PUSHs (next->proc);
182
183 PUTBACK;
184 /*
185 * the next line is slightly wrong, as PL_op->op_next
186 * is actually being executed so we skip the first op
187 * that doens't matter, though, since it is only
188 * pp_nextstate and we never return...
189 */
190 PL_op = Perl_pp_entersub(aTHX);
191 SPAGAIN;
192
193 ENTER;
194 }
195 }
196 552
197void 553void
198DESTROY(coro) 554DESTROY(coro)
199 Coro::State coro 555 Coro::State coro
200 CODE: 556 CODE:
201 557
202 if (coro->mainstack) 558 if (coro->mainstack)
203 { 559 {
204 struct coro temp; 560 struct coro temp;
205 561
206 PUTBACK;
207 SAVE((&temp)); 562 SAVE(aTHX_ (&temp), SAVE_ALL);
208 LOAD(coro); 563 LOAD(aTHX_ coro);
209 564
210 S_nuke_stacks (); 565 destroy_stacks ();
211 SvREFCNT_dec ((SV *)GvAV (PL_defgv));
212 566
213 LOAD((&temp)); 567 LOAD((&temp)); /* this will get rid of defsv etc.. */
214 SPAGAIN;
215 } 568 }
216 569
217 SvREFCNT_dec (coro->proc);
218 Safefree (coro); 570 Safefree (coro);
219 571
572void
573flush()
574 CODE:
575#ifdef MAY_FLUSH
576 flush_padlist_cache ();
577#endif
220 578
579MODULE = Coro::State PACKAGE = Coro::Cont
580
581# this is dirty and should be in it's own .xs
582
583void
584result(...)
585 PROTOTYPE: @
586 CODE:
587 static SV *returnstk;
588 SV *sv;
589 AV *defav = GvAV (PL_defgv);
590 struct coro *prev, *next;
591
592 if (!returnstk)
593 returnstk = SvRV (get_sv ("Coro::Cont::return", FALSE));
594
595 /* set up @_ */
596 av_clear (defav);
597 av_fill (defav, items - 1);
598 while (items--)
599 av_store (defav, items, SvREFCNT_inc (ST(items)));
600
601 mg_get (returnstk); /* isn't documentation wrong for mg_get? */
602 sv = av_pop ((AV *)SvRV (returnstk));
603 prev = (struct coro *)SvIV ((SV*)SvRV (*av_fetch ((AV *)SvRV (sv), 0, 0)));
604 next = (struct coro *)SvIV ((SV*)SvRV (*av_fetch ((AV *)SvRV (sv), 1, 0)));
605 SvREFCNT_dec (sv);
606 transfer(prev, next, 0);
607

Diff Legend

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