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.4 by root, Tue Jul 17 02:21:56 2001 UTC vs.
Revision 1.12 by root, Sun Jul 22 03:24:10 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 0 5#if 1
6# define CHK(x) (void *)0 6# define CHK(x) (void *)0
7#else 7#else
8# define CHK(x) if (!(x)) croak("FATAL, CHK: " #x) 8# define CHK(x) if (!(x)) croak("FATAL, CHK: " #x)
9#endif 9#endif
10 10
11#define MAY_FLUSH /* increases codesize */
12
13#define SUB_INIT "Coro::State::initialize"
14
15#define TRANSFER_SAVE_DEFAV 0x00000001
16#define TRANSFER_SAVE_DEFSV 0x00000002
17#define TRANSFER_SAVE_ERRSV 0x00000004
18
19#define TRANSFER_SAVE_ALL -1
20
11struct 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 */
12 U8 dowarn; 28 U8 dowarn;
13 AV *defav; 29
14 30 /* the stacks and related info (callchain etc..) */
15 PERL_SI *curstackinfo; 31 PERL_SI *curstackinfo;
16 AV *curstack; 32 AV *curstack;
17 AV *mainstack; 33 AV *mainstack;
18 SV **stack_sp; 34 SV **stack_sp;
19 OP *op; 35 OP *op;
… …
36 OP **retstack; 52 OP **retstack;
37 I32 retstack_ix; 53 I32 retstack_ix;
38 I32 retstack_max; 54 I32 retstack_max;
39 COP *curcop; 55 COP *curcop;
40 56
57 /* data associated with this coroutine (initial args) */
41 AV *args; 58 AV *args;
42}; 59};
43 60
44typedef struct coro *Coro__State; 61typedef struct coro *Coro__State;
45typedef struct coro *Coro__State_or_hashref; 62typedef struct coro *Coro__State_or_hashref;
63
64static AV *main_mainstack; /* used to differentiate between $main and others */
46 65
47static HV *padlist_cache; 66static HV *padlist_cache;
48 67
49/* mostly copied from op.c:cv_clone2 */ 68/* mostly copied from op.c:cv_clone2 */
50STATIC AV * 69STATIC AV *
… …
115 SvPADTMP_on (sv); 134 SvPADTMP_on (sv);
116 npad[ix] = sv; 135 npad[ix] = sv;
117 } 136 }
118 } 137 }
119 138
120#if 0 /* NONOTUNDERSTOOD */ 139#if 0 /* return -ENOTUNDERSTOOD */
121 /* Now that vars are all in place, clone nested closures. */ 140 /* Now that vars are all in place, clone nested closures. */
122 141
123 for (ix = fpad; ix > 0; ix--) { 142 for (ix = fpad; ix > 0; ix--) {
124 SV* namesv = (ix <= fname) ? pname[ix] : Nullsv; 143 SV* namesv = (ix <= fname) ? pname[ix] : Nullsv;
125 if (namesv 144 if (namesv
… …
138#endif 157#endif
139 158
140 return newpadlist; 159 return newpadlist;
141} 160}
142 161
162#ifdef MAY_FLUSH
143STATIC AV * 163STATIC AV *
144free_padlist (AV *padlist) 164free_padlist (AV *padlist)
145{ 165{
146 /* may be during global destruction */ 166 /* may be during global destruction */
147 if (SvREFCNT(padlist)) 167 if (SvREFCNT(padlist))
… …
156 } 176 }
157 177
158 SvREFCNT_dec((SV*)padlist); 178 SvREFCNT_dec((SV*)padlist);
159 } 179 }
160} 180}
181#endif
161 182
162/* the next tow functions merely cache the padlists */ 183/* the next two functions merely cache the padlists */
163STATIC void 184STATIC void
164get_padlist (CV *cv) 185get_padlist (CV *cv)
165{ 186{
166 SV **he = hv_fetch (padlist_cache, (void *)&cv, sizeof (CV *), 0); 187 SV **he = hv_fetch (padlist_cache, (void *)&cv, sizeof (CV *), 0);
167 188
… …
183 } 204 }
184 205
185 av_push ((AV *)*he, (SV *)CvPADLIST (cv)); 206 av_push ((AV *)*he, (SV *)CvPADLIST (cv));
186} 207}
187 208
209#ifdef MAY_FLUSH
210STATIC void
211flush_padlist_cache ()
212{
213 HV *hv = padlist_cache;
214 padlist_cache = newHV ();
215
216 if (hv_iterinit (hv))
217 {
218 HE *he;
219 AV *padlist;
220
221 while (!!(he = hv_iternext (hv)))
222 {
223 AV *av = (AV *)HeVAL(he);
224
225 /* casting is fun. */
226 while (&PL_sv_undef != (SV *)(padlist = (AV *)av_pop (av)))
227 free_padlist (padlist);
228 }
229 }
230
231 SvREFCNT_dec (hv);
232}
233#endif
234
235#define SB do {
236#define SE } while (0)
237
238#define LOAD(state) SB load_state(aTHX_ state); SPAGAIN; SE
239#define SAVE(state,flags) SB PUTBACK; save_state(aTHX_ state,flags); SE
240
241#define REPLACE_SV(sv,val) SB SvREFCNT_dec(sv); (sv) = (val); SE
242
188static void 243static void
189SAVE(pTHX_ Coro__State c) 244load_state(pTHX_ Coro__State c)
245{
246 PL_dowarn = c->dowarn;
247
248 PL_curstackinfo = c->curstackinfo;
249 PL_curstack = c->curstack;
250 PL_mainstack = c->mainstack;
251 PL_stack_sp = c->stack_sp;
252 PL_op = c->op;
253 PL_curpad = c->curpad;
254 PL_stack_base = c->stack_base;
255 PL_stack_max = c->stack_max;
256 PL_tmps_stack = c->tmps_stack;
257 PL_tmps_floor = c->tmps_floor;
258 PL_tmps_ix = c->tmps_ix;
259 PL_tmps_max = c->tmps_max;
260 PL_markstack = c->markstack;
261 PL_markstack_ptr = c->markstack_ptr;
262 PL_markstack_max = c->markstack_max;
263 PL_scopestack = c->scopestack;
264 PL_scopestack_ix = c->scopestack_ix;
265 PL_scopestack_max = c->scopestack_max;
266 PL_savestack = c->savestack;
267 PL_savestack_ix = c->savestack_ix;
268 PL_savestack_max = c->savestack_max;
269 PL_retstack = c->retstack;
270 PL_retstack_ix = c->retstack_ix;
271 PL_retstack_max = c->retstack_max;
272 PL_curcop = c->curcop;
273
274 if (c->defav) REPLACE_SV (GvAV (PL_defgv), c->defav);
275 if (c->defsv) REPLACE_SV (DEFSV , c->defsv);
276 if (c->errsv) REPLACE_SV (ERRSV , c->errsv);
277
278 {
279 dSP;
280 CV *cv;
281
282 /* now do the ugly restore mess */
283 while ((cv = (CV *)POPs))
284 {
285 AV *padlist = (AV *)POPs;
286
287 if (padlist)
288 {
289 put_padlist (cv); /* mark this padlist as available */
290 CvPADLIST(cv) = padlist;
291#ifdef USE_THREADS
292 /*CvOWNER(cv) = (struct perl_thread *)POPs;*/
293#endif
294 }
295
296 ++CvDEPTH(cv);
297 }
298
299 PUTBACK;
300 }
301}
302
303static void
304save_state(pTHX_ Coro__State c, int flags)
190{ 305{
191 { 306 {
192 dSP; 307 dSP;
193 I32 cxix = cxstack_ix; 308 I32 cxix = cxstack_ix;
309 PERL_CONTEXT *ccstk = cxstack;
194 PERL_SI *top_si = PL_curstackinfo; 310 PERL_SI *top_si = PL_curstackinfo;
195 PERL_CONTEXT *ccstk = cxstack;
196 311
197 /* 312 /*
198 * the worst thing you can imagine happens first - we have to save 313 * the worst thing you can imagine happens first - we have to save
199 * (and reinitialize) all cv's in the whole callchain :( 314 * (and reinitialize) all cv's in the whole callchain :(
200 */ 315 */
201 316
202 PUSHs (Nullsv); 317 PUSHs (Nullsv);
203 /* this loop was inspired by pp_caller */ 318 /* this loop was inspired by pp_caller */
204 for (;;) 319 for (;;)
205 { 320 {
206 while (cxix >= 0) 321 do
207 { 322 {
208 PERL_CONTEXT *cx = &ccstk[cxix--]; 323 PERL_CONTEXT *cx = &ccstk[cxix--];
209 324
210 if (CxTYPE(cx) == CXt_SUB) 325 if (CxTYPE(cx) == CXt_SUB)
211 { 326 {
212 CV *cv = cx->blk_sub.cv; 327 CV *cv = cx->blk_sub.cv;
213 if (CvDEPTH(cv)) 328 if (CvDEPTH(cv))
214 { 329 {
215#ifdef USE_THREADS 330#ifdef USE_THREADS
216 XPUSHs ((SV *)CvOWNER(cv)); 331 /*XPUSHs ((SV *)CvOWNER(cv));*/
332 /*CvOWNER(cv) = 0;*/
333 /*error must unlock this cv etc.. etc...*/
217#endif 334#endif
218 EXTEND (SP, 3); 335 EXTEND (SP, CvDEPTH(cv)*2);
336
337 while (--CvDEPTH(cv))
338 {
339 /* this tells the restore code to increment CvDEPTH */
340 PUSHs (Nullsv);
219 PUSHs ((SV *)CvDEPTH(cv)); 341 PUSHs ((SV *)cv);
342 }
343
220 PUSHs ((SV *)CvPADLIST(cv)); 344 PUSHs ((SV *)CvPADLIST(cv));
221 PUSHs ((SV *)cv); 345 PUSHs ((SV *)cv);
222 346
223 get_padlist (cv); 347 get_padlist (cv); /* this is a monster */
224
225 CvDEPTH(cv) = 0;
226#ifdef USE_THREADS
227 CvOWNER(cv) = 0;
228 error must unlock this cv etc.. etc...
229 if you are here wondering about this error message then
230 the reason is that it will not work as advertised yet
231#endif
232 } 348 }
233 } 349 }
234 else if (CxTYPE(cx) == CXt_FORMAT) 350 else if (CxTYPE(cx) == CXt_FORMAT)
235 { 351 {
236 /* I never used formats, so how should I know how these are implemented? */ 352 /* I never used formats, so how should I know how these are implemented? */
237 /* my bold guess is as a simple, plain sub... */ 353 /* my bold guess is as a simple, plain sub... */
238 croak ("CXt_FORMAT not yet handled. Don't switch coroutines from within formats"); 354 croak ("CXt_FORMAT not yet handled. Don't switch coroutines from within formats");
239 } 355 }
240 } 356 }
357 while (cxix >= 0);
241 358
242 if (top_si->si_type == PERLSI_MAIN) 359 if (top_si->si_type == PERLSI_MAIN)
243 break; 360 break;
244 361
245 top_si = top_si->si_prev; 362 top_si = top_si->si_prev;
… …
248 } 365 }
249 366
250 PUTBACK; 367 PUTBACK;
251 } 368 }
252 369
370 c->defav = flags & TRANSFER_SAVE_DEFAV ? (AV *)SvREFCNT_inc (GvAV (PL_defgv)) : 0;
371 c->defsv = flags & TRANSFER_SAVE_DEFSV ? SvREFCNT_inc (DEFSV) : 0;
372 c->errsv = flags & TRANSFER_SAVE_ERRSV ? SvREFCNT_inc (ERRSV) : 0;
373
374 /* I have not the slightest idea of why av_reify is necessary */
375 /* but if it's missing the defav contents magically get replaced sometimes */
376 if (c->defav)
377 av_reify (c->defav);
378
253 c->dowarn = PL_dowarn; 379 c->dowarn = PL_dowarn;
254 c->defav = GvAV (PL_defgv); 380
255 c->curstackinfo = PL_curstackinfo; 381 c->curstackinfo = PL_curstackinfo;
256 c->curstack = PL_curstack; 382 c->curstack = PL_curstack;
257 c->mainstack = PL_mainstack; 383 c->mainstack = PL_mainstack;
258 c->stack_sp = PL_stack_sp; 384 c->stack_sp = PL_stack_sp;
259 c->op = PL_op; 385 c->op = PL_op;
… …
277 c->retstack_ix = PL_retstack_ix; 403 c->retstack_ix = PL_retstack_ix;
278 c->retstack_max = PL_retstack_max; 404 c->retstack_max = PL_retstack_max;
279 c->curcop = PL_curcop; 405 c->curcop = PL_curcop;
280} 406}
281 407
282static void 408/*
283LOAD(pTHX_ Coro__State c) 409 * destroy the stacks, the callchain etc...
284{ 410 * still there is a memleak of 128 bytes...
285 PL_dowarn = c->dowarn; 411 */
286 GvAV (PL_defgv) = c->defav;
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_stack_base = c->stack_base;
294 PL_stack_max = c->stack_max;
295 PL_tmps_stack = c->tmps_stack;
296 PL_tmps_floor = c->tmps_floor;
297 PL_tmps_ix = c->tmps_ix;
298 PL_tmps_max = c->tmps_max;
299 PL_markstack = c->markstack;
300 PL_markstack_ptr = c->markstack_ptr;
301 PL_markstack_max = c->markstack_max;
302 PL_scopestack = c->scopestack;
303 PL_scopestack_ix = c->scopestack_ix;
304 PL_scopestack_max = c->scopestack_max;
305 PL_savestack = c->savestack;
306 PL_savestack_ix = c->savestack_ix;
307 PL_savestack_max = c->savestack_max;
308 PL_retstack = c->retstack;
309 PL_retstack_ix = c->retstack_ix;
310 PL_retstack_max = c->retstack_max;
311 PL_curcop = c->curcop;
312
313 {
314 dSP;
315 CV *cv;
316
317 /* now do the ugly restore mess */
318 while ((cv = (CV *)POPs))
319 {
320 AV *padlist = (AV *)POPs;
321
322 put_padlist (cv);
323 CvPADLIST(cv) = padlist;
324 CvDEPTH(cv) = (I32)POPs;
325
326#ifdef USE_THREADS
327 CvOWNER(cv) = (struct perl_thread *)POPs;
328 error does not work either
329#endif
330 }
331
332 PUTBACK;
333 }
334}
335
336/* this is an EXACT copy of S_nuke_stacks in perl.c, which is unfortunately static */
337STATIC void 412STATIC void
338destroy_stacks(pTHX) 413destroy_stacks(pTHX)
339{ 414{
340 dSP;
341
342 /* die does this while calling POPSTACK, but I just don't see why. */
343 dounwind(-1);
344
345 /* is this ugly, I ask? */ 415 /* is this ugly, I ask? */
346 while (PL_scopestack_ix) 416 while (PL_scopestack_ix)
347 LEAVE; 417 LEAVE;
348 418
419 /* sure it is, but more important: is it correct?? :/ */
420 while (PL_tmps_ix > PL_tmps_floor) /* should only ever be one iteration */
421 FREETMPS;
422
349 while (PL_curstackinfo->si_next) 423 while (PL_curstackinfo->si_next)
350 PL_curstackinfo = PL_curstackinfo->si_next; 424 PL_curstackinfo = PL_curstackinfo->si_next;
351 425
352 while (PL_curstackinfo) 426 while (PL_curstackinfo)
353 { 427 {
354 PERL_SI *p = PL_curstackinfo->si_prev; 428 PERL_SI *p = PL_curstackinfo->si_prev;
429
430 {
431 dSP;
432 SWITCHSTACK (PL_curstack, PL_curstackinfo->si_stack);
433 PUTBACK; /* possibly superfluous */
434 }
435
436 dounwind(-1);
355 437
356 SvREFCNT_dec(PL_curstackinfo->si_stack); 438 SvREFCNT_dec(PL_curstackinfo->si_stack);
357 Safefree(PL_curstackinfo->si_cxstack); 439 Safefree(PL_curstackinfo->si_cxstack);
358 Safefree(PL_curstackinfo); 440 Safefree(PL_curstackinfo);
359 PL_curstackinfo = p; 441 PL_curstackinfo = p;
360 } 442 }
361 443
362 if (PL_scopestack_ix != 0)
363 Perl_warner(aTHX_ WARN_INTERNAL,
364 "Unbalanced scopes: %ld more ENTERs than LEAVEs\n",
365 (long)PL_scopestack_ix);
366 if (PL_savestack_ix != 0)
367 Perl_warner(aTHX_ WARN_INTERNAL,
368 "Unbalanced saves: %ld more saves than restores\n",
369 (long)PL_savestack_ix);
370 if (PL_tmps_floor != -1)
371 Perl_warner(aTHX_ WARN_INTERNAL,"Unbalanced tmps: %ld more allocs than frees\n",
372 (long)PL_tmps_floor + 1);
373 /*
374 */
375 Safefree(PL_tmps_stack); 444 Safefree(PL_tmps_stack);
376 Safefree(PL_markstack); 445 Safefree(PL_markstack);
377 Safefree(PL_scopestack); 446 Safefree(PL_scopestack);
378 Safefree(PL_savestack); 447 Safefree(PL_savestack);
379 Safefree(PL_retstack); 448 Safefree(PL_retstack);
380} 449}
381 450
382#define SUB_INIT "Coro::State::_newcoro" 451STATIC void
452transfer(pTHX_ struct coro *prev, struct coro *next, int flags)
453{
454 dSP;
455
456 if (prev != next)
457 {
458 /*
459 * this could be done in newprocess which would lead to
460 * extremely elegant and fast (just SAVE/LOAD)
461 * code here, but lazy allocation of stacks has also
462 * some virtues and the overhead of the if() is nil.
463 */
464 if (next->mainstack)
465 {
466 SAVE (prev, flags);
467 LOAD (next);
468 /* mark this state as in-use */
469 next->mainstack = 0;
470 next->tmps_ix = -2;
471 }
472 else if (next->tmps_ix == -2)
473 {
474 croak ("tried to transfer to running coroutine");
475 }
476 else
477 {
478 /*
479 * emulate part of the perl startup here.
480 */
481 UNOP myop;
482
483 SAVE (prev, -1); /* first get rid of the old state */
484
485 init_stacks (); /* from perl.c */
486 SPAGAIN;
487
488 PL_op = (OP *)&myop;
489 /*PL_curcop = 0;*/
490 SvREFCNT_dec (GvAV (PL_defgv));
491 GvAV (PL_defgv) = next->args;
492
493 Zero(&myop, 1, UNOP);
494 myop.op_next = Nullop;
495 myop.op_flags = OPf_WANT_VOID;
496
497 PUSHMARK(SP);
498 XPUSHs ((SV*)get_cv(SUB_INIT, TRUE));
499 /*
500 * the next line is slightly wrong, as PL_op->op_next
501 * is actually being executed so we skip the first op.
502 * that doesn't matter, though, since it is only
503 * pp_nextstate and we never return...
504 * ah yes, and I don't care anyways ;)
505 */
506 PUTBACK;
507 PL_op = pp_entersub(aTHX);
508 SPAGAIN;
509
510 ENTER; /* necessary e.g. for dounwind */
511 }
512 }
513}
383 514
384MODULE = Coro::State PACKAGE = Coro::State 515MODULE = Coro::State PACKAGE = Coro::State
385 516
386PROTOTYPES: ENABLE 517PROTOTYPES: ENABLE
387 518
388BOOT: 519BOOT:
520{ /* {} necessary for stoopid perl-5.6.x */
521 HV * stash = gv_stashpvn("Coro::State", 10, TRUE);
522
523 newCONSTSUB (stash, "SAVE_DEFAV", newSViv (TRANSFER_SAVE_DEFAV));
524 newCONSTSUB (stash, "SAVE_DEFSV", newSViv (TRANSFER_SAVE_DEFSV));
525 newCONSTSUB (stash, "SAVE_ERRSV", newSViv (TRANSFER_SAVE_ERRSV));
526
389 if (!padlist_cache) 527 if (!padlist_cache)
390 padlist_cache = newHV (); 528 padlist_cache = newHV ();
529
530 main_mainstack = PL_mainstack;
531}
391 532
392Coro::State 533Coro::State
393_newprocess(args) 534_newprocess(args)
394 SV * args 535 SV * args
395 PROTOTYPE: $ 536 PROTOTYPE: $
396 CODE: 537 CODE:
397 Coro__State coro; 538 Coro__State coro;
398 539
399 if (!SvROK (args) || SvTYPE (SvRV (args)) != SVt_PVAV) 540 if (!SvROK (args) || SvTYPE (SvRV (args)) != SVt_PVAV)
400 croak ("Coro::State::newprocess expects an arrayref"); 541 croak ("Coro::State::_newprocess expects an arrayref");
401 542
402 New (0, coro, 1, struct coro); 543 New (0, coro, 1, struct coro);
403 544
404 coro->mainstack = 0; /* actual work is done inside transfer */ 545 coro->mainstack = 0; /* actual work is done inside transfer */
405 coro->args = (AV *)SvREFCNT_inc (SvRV (args)); 546 coro->args = (AV *)SvREFCNT_inc (SvRV (args));
… …
407 RETVAL = coro; 548 RETVAL = coro;
408 OUTPUT: 549 OUTPUT:
409 RETVAL 550 RETVAL
410 551
411void 552void
412transfer(prev,next) 553transfer(prev, next, flags = TRANSFER_SAVE_ALL)
413 Coro::State_or_hashref prev 554 Coro::State_or_hashref prev
414 Coro::State_or_hashref next 555 Coro::State_or_hashref next
556 int flags
557 PROTOTYPE: @
415 CODE: 558 CODE:
416 559
417 if (prev != next) 560 transfer (aTHX_ prev, next, flags);
418 {
419 PUTBACK;
420 SAVE (aTHX_ prev);
421
422 /*
423 * this could be done in newprocess which would lead to
424 * extremely elegant and fast (just PUTBACK/SAVE/LOAD/SPAGAIN)
425 * code here, but lazy allocation of stacks has also
426 * some virtues and the overhead of the if() is nil.
427 */
428 if (next->mainstack)
429 {
430 LOAD (aTHX_ next);
431 next->mainstack = 0; /* unnecessary but much cleaner */
432 SPAGAIN;
433 }
434 else
435 {
436 /*
437 * emulate part of the perl startup here.
438 */
439 UNOP myop;
440
441 init_stacks (); /* from perl.c */
442 PL_op = (OP *)&myop;
443 /*PL_curcop = 0;*/
444 GvAV (PL_defgv) = (SV *)SvREFCNT_inc (next->args);
445
446 SPAGAIN;
447 Zero(&myop, 1, UNOP);
448 myop.op_next = Nullop;
449 myop.op_flags = OPf_WANT_VOID;
450
451 PUSHMARK(SP);
452 XPUSHs ((SV*)get_cv(SUB_INIT, TRUE));
453 PUTBACK;
454 /*
455 * the next line is slightly wrong, as PL_op->op_next
456 * is actually being executed so we skip the first op.
457 * that doesn't matter, though, since it is only
458 * pp_nextstate and we never return...
459 */
460 PL_op = Perl_pp_entersub(aTHX);
461 SPAGAIN;
462
463 ENTER;
464 }
465 }
466 561
467void 562void
468DESTROY(coro) 563DESTROY(coro)
469 Coro::State coro 564 Coro::State coro
470 CODE: 565 CODE:
471 566
472 if (coro->mainstack) 567 if (coro->mainstack && coro->mainstack != main_mainstack)
473 { 568 {
474 struct coro temp; 569 struct coro temp;
475 570
476 PUTBACK;
477 SAVE(aTHX_ (&temp)); 571 SAVE(aTHX_ (&temp), TRANSFER_SAVE_ALL);
478 LOAD(aTHX_ coro); 572 LOAD(aTHX_ coro);
479 573
480 destroy_stacks (); 574 destroy_stacks ();
481 SvREFCNT_dec ((SV *)GvAV (PL_defgv));
482 575
483 LOAD((&temp)); 576 LOAD((&temp)); /* this will get rid of defsv etc.. */
484 SPAGAIN;
485 } 577 }
486 578
487 SvREFCNT_dec (coro->args);
488 Safefree (coro); 579 Safefree (coro);
489 580
581 /*
582 * there is one problematic case left (remember _recurse?)
583 * consider the case when we
584 *
585 * 1. start a coroutine
586 * 2. inside it descend into some xs functions
587 * 3. xs function calls a callback
588 * 4. callback switches to $main
589 * 5. $main ends - we will end inside the xs function
590 * 6. xs function returns and perl executes - what?
591 *
592 * to avoid this case we recurse in this function
593 * and simply call my_exit(0), skipping other xs functions
594 */
490 595
596#if 0
597void
598_recurse()
599 CODE:
600 LEAVE;
601 PL_stack_sp = PL_stack_base + ax - 1;
602 PL_op = PL_op->op_next;
603 CALLRUNOPS(aTHX);
604 printf ("my_exit\n");
605 my_exit (0);
606
607#endif
608
609void
610flush()
611 CODE:
612#ifdef MAY_FLUSH
613 flush_padlist_cache ();
614#endif
615
616MODULE = Coro::State PACKAGE = Coro::Cont
617
618# this is dirty (do you hear me?) and should be in it's own .xs
619
620void
621result(...)
622 PROTOTYPE: @
623 CODE:
624 static SV *returnstk;
625 SV *sv;
626 AV *defav = GvAV (PL_defgv);
627 struct coro *prev, *next;
628
629 if (!returnstk)
630 returnstk = SvRV (get_sv ("Coro::Cont::return", FALSE));
631
632 /* set up @_ -- ugly */
633 av_clear (defav);
634 av_fill (defav, items - 1);
635 while (items--)
636 av_store (defav, items, SvREFCNT_inc (ST(items)));
637
638 mg_get (returnstk); /* isn't documentation wrong for mg_get? */
639 sv = av_pop ((AV *)SvRV (returnstk));
640 prev = (struct coro *)SvIV ((SV*)SvRV (*av_fetch ((AV *)SvRV (sv), 0, 0)));
641 next = (struct coro *)SvIV ((SV*)SvRV (*av_fetch ((AV *)SvRV (sv), 1, 0)));
642 SvREFCNT_dec (sv);
643 transfer(prev, next, 0);
644

Diff Legend

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