… | |
… | |
350 | /* |
350 | /* |
351 | * the worst thing you can imagine happens first - we have to save |
351 | * the worst thing you can imagine happens first - we have to save |
352 | * (and reinitialize) all cv's in the whole callchain :( |
352 | * (and reinitialize) all cv's in the whole callchain :( |
353 | */ |
353 | */ |
354 | |
354 | |
|
|
355 | EXTEND (SP, 3 + 1); |
355 | PUSHs (Nullsv); |
356 | PUSHs (Nullsv); |
356 | /* this loop was inspired by pp_caller */ |
357 | /* this loop was inspired by pp_caller */ |
357 | for (;;) |
358 | for (;;) |
358 | { |
359 | { |
359 | while (cxix >= 0) |
360 | while (cxix >= 0) |
… | |
… | |
365 | CV *cv = cx->blk_sub.cv; |
366 | CV *cv = cx->blk_sub.cv; |
366 | |
367 | |
367 | if (CvDEPTH (cv)) |
368 | if (CvDEPTH (cv)) |
368 | { |
369 | { |
369 | EXTEND (SP, 3); |
370 | EXTEND (SP, 3); |
370 | |
|
|
371 | PUSHs ((SV *)CvPADLIST (cv)); |
371 | PUSHs ((SV *)CvPADLIST (cv)); |
372 | PUSHs (INT2PTR (SV *, CvDEPTH (cv))); |
372 | PUSHs (INT2PTR (SV *, CvDEPTH (cv))); |
373 | PUSHs ((SV *)cv); |
373 | PUSHs ((SV *)cv); |
374 | |
374 | |
375 | CvDEPTH (cv) = 0; |
375 | CvDEPTH (cv) = 0; |
376 | get_padlist (cv); |
376 | get_padlist (cv); |
377 | } |
377 | } |
378 | } |
378 | } |
379 | #ifdef CXt_FORMAT |
|
|
380 | else if (CxTYPE (cx) == CXt_FORMAT) |
|
|
381 | { |
|
|
382 | /* I never used formats, so how should I know how these are implemented? */ |
|
|
383 | /* my bold guess is as a simple, plain sub... */ |
|
|
384 | croak ("CXt_FORMAT not yet handled. Don't switch coroutines from within formats"); |
|
|
385 | } |
|
|
386 | #endif |
|
|
387 | } |
379 | } |
388 | |
380 | |
389 | if (top_si->si_type == PERLSI_MAIN) |
381 | if (top_si->si_type == PERLSI_MAIN) |
390 | break; |
382 | break; |
391 | |
383 | |
… | |
… | |
411 | * allocate various perl stacks. This is an exact copy |
403 | * allocate various perl stacks. This is an exact copy |
412 | * of perl.c:init_stacks, except that it uses less memory |
404 | * of perl.c:init_stacks, except that it uses less memory |
413 | * on the (sometimes correct) assumption that coroutines do |
405 | * on the (sometimes correct) assumption that coroutines do |
414 | * not usually need a lot of stackspace. |
406 | * not usually need a lot of stackspace. |
415 | */ |
407 | */ |
|
|
408 | #if USE_PERL_INIT_STACKS |
|
|
409 | # define coro_init_stacks init_stacks |
|
|
410 | #else |
|
|
411 | |
416 | static void |
412 | static void |
417 | coro_init_stacks () |
413 | coro_init_stacks () |
418 | { |
414 | { |
419 | PL_curstackinfo = new_stackinfo(128, 1024/sizeof(PERL_CONTEXT)); |
415 | PL_curstackinfo = new_stackinfo(128, 1024/sizeof(PERL_CONTEXT)); |
420 | PL_curstackinfo->si_type = PERLSI_MAIN; |
416 | PL_curstackinfo->si_type = PERLSI_MAIN; |
… | |
… | |
459 | static void |
455 | static void |
460 | coro_destroy_stacks () |
456 | coro_destroy_stacks () |
461 | { |
457 | { |
462 | if (!IN_DESTRUCT) |
458 | if (!IN_DESTRUCT) |
463 | { |
459 | { |
464 | /* is this ugly, I ask? */ |
460 | /* restore all saved variables and stuff */ |
465 | LEAVE_SCOPE (0); |
461 | LEAVE_SCOPE (0); |
|
|
462 | assert (PL_tmps_floor == -1); |
466 | |
463 | |
467 | /* sure it is, but more important: is it correct?? :/ */ |
464 | /* free all temporaries */ |
468 | FREETMPS; |
465 | FREETMPS; |
|
|
466 | assert (PL_tmps_ix == -1); |
469 | |
467 | |
470 | /*POPSTACK_TO (PL_mainstack);*//*D*//*use*/ |
468 | POPSTACK_TO (PL_mainstack); |
471 | } |
469 | } |
472 | |
470 | |
473 | while (PL_curstackinfo->si_next) |
471 | while (PL_curstackinfo->si_next) |
474 | PL_curstackinfo = PL_curstackinfo->si_next; |
472 | PL_curstackinfo = PL_curstackinfo->si_next; |
475 | |
473 | |
476 | while (PL_curstackinfo) |
474 | while (PL_curstackinfo) |
477 | { |
475 | { |
478 | PERL_SI *p = PL_curstackinfo->si_prev; |
476 | PERL_SI *p = PL_curstackinfo->si_prev; |
479 | |
477 | |
480 | { /*D*//*remove*/ |
|
|
481 | dSP; |
|
|
482 | SWITCHSTACK (PL_curstack, PL_curstackinfo->si_stack); |
|
|
483 | PUTBACK; /* possibly superfluous */ |
|
|
484 | } |
|
|
485 | |
|
|
486 | if (!IN_DESTRUCT) |
478 | if (!IN_DESTRUCT) |
487 | { |
|
|
488 | dounwind (-1);/*D*//*remove*/ |
|
|
489 | SvREFCNT_dec (PL_curstackinfo->si_stack); |
479 | SvREFCNT_dec (PL_curstackinfo->si_stack); |
490 | } |
|
|
491 | |
480 | |
492 | Safefree (PL_curstackinfo->si_cxstack); |
481 | Safefree (PL_curstackinfo->si_cxstack); |
493 | Safefree (PL_curstackinfo); |
482 | Safefree (PL_curstackinfo); |
494 | PL_curstackinfo = p; |
483 | PL_curstackinfo = p; |
495 | } |
484 | } |
… | |
… | |
500 | Safefree (PL_savestack); |
489 | Safefree (PL_savestack); |
501 | #if !PERL_VERSION_ATLEAST (5,9,0) |
490 | #if !PERL_VERSION_ATLEAST (5,9,0) |
502 | Safefree (PL_retstack); |
491 | Safefree (PL_retstack); |
503 | #endif |
492 | #endif |
504 | } |
493 | } |
|
|
494 | #endif |
505 | |
495 | |
506 | static void |
496 | static void |
507 | setup_coro (struct coro *coro) |
497 | setup_coro (struct coro *coro) |
508 | { |
498 | { |
509 | /* |
499 | /* |