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.7 by root, Thu Jul 19 02:45:09 2001 UTC vs.
Revision 1.8 by root, Thu Jul 19 04:13:22 2001 UTC

… …
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 */ 11#define MAY_FLUSH /* increases codesize */
12
13#define SUB_INIT "Coro::State::_newcoro"
12 14
13#define SAVE_DEFAV 0x00000001 15#define SAVE_DEFAV 0x00000001
14#define SAVE_DEFSV 0x00000002 16#define SAVE_DEFSV 0x00000002
15#define SAVE_ERRSV 0x00000004 17#define SAVE_ERRSV 0x00000004
16 18
… …
437 Safefree(PL_scopestack); 439 Safefree(PL_scopestack);
438 Safefree(PL_savestack); 440 Safefree(PL_savestack);
439 Safefree(PL_retstack); 441 Safefree(PL_retstack);
440} 442}
441 443
442#define SUB_INIT "Coro::State::_newcoro" 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}
443 507
444MODULE = Coro::State PACKAGE = Coro::State 508MODULE = Coro::State PACKAGE = Coro::State
445 509
446PROTOTYPES: ENABLE 510PROTOTYPES: ENABLE
447 511
… …
477void 541void
478transfer(prev, next, flags = SAVE_DEFAV) 542transfer(prev, next, flags = SAVE_DEFAV)
479 Coro::State_or_hashref prev 543 Coro::State_or_hashref prev
480 Coro::State_or_hashref next 544 Coro::State_or_hashref next
481 int flags 545 int flags
546 PROTOTYPE: @
482 CODE: 547 CODE:
483 548
484 if (prev != next) 549 transfer (aTHX_ prev, next, flags);
485 {
486 /*
487 * this could be done in newprocess which would lead to
488 * extremely elegant and fast (just SAVE/LOAD)
489 * code here, but lazy allocation of stacks has also
490 * some virtues and the overhead of the if() is nil.
491 */
492 if (next->mainstack)
493 {
494 SAVE (prev, flags);
495 LOAD (next);
496 /* mark this state as in-use */
497 next->mainstack = 0;
498 next->tmps_ix = -2;
499 }
500 else if (next->tmps_ix == -2)
501 {
502 croak ("tried to transfer to running coroutine");
503 }
504 else
505 {
506 /*
507 * emulate part of the perl startup here.
508 */
509 UNOP myop;
510
511 SAVE (prev, -1); /* first get rid of the old state */
512
513 init_stacks (); /* from perl.c */
514 SPAGAIN;
515
516 PL_op = (OP *)&myop;
517 /*PL_curcop = 0;*/
518 SvREFCNT_dec (GvAV (PL_defgv));
519 GvAV (PL_defgv) = next->args;
520
521 Zero(&myop, 1, UNOP);
522 myop.op_next = Nullop;
523 myop.op_flags = OPf_WANT_VOID;
524
525 PUSHMARK(SP);
526 XPUSHs ((SV*)get_cv(SUB_INIT, TRUE));
527 /*
528 * the next line is slightly wrong, as PL_op->op_next
529 * is actually being executed so we skip the first op.
530 * that doesn't matter, though, since it is only
531 * pp_nextstate and we never return...
532 * ah yes, and I don't care anyways ;)
533 */
534 PUTBACK;
535 PL_op = pp_entersub(aTHX);
536 SPAGAIN;
537
538 ENTER; /* necessary e.g. for dounwind */
539 }
540 }
541 550
542void 551void
543DESTROY(coro) 552DESTROY(coro)
544 Coro::State coro 553 Coro::State coro
545 CODE: 554 CODE:
… …
563 CODE: 572 CODE:
564#ifdef MAY_FLUSH 573#ifdef MAY_FLUSH
565 flush_padlist_cache (); 574 flush_padlist_cache ();
566#endif 575#endif
567 576
577MODULE = Coro::State PACKAGE = Coro::Cont
568 578
579# this is dirty and should be in it's own .xs
580
581void
582result(...)
583 PROTOTYPE: @
584 CODE:
585 static SV *returnstk;
586 SV *sv;
587 AV *defav = GvAV (PL_defgv);
588 struct coro *prev, *next;
589
590 if (!returnstk)
591 returnstk = SvRV (get_sv ("Coro::Cont::return", FALSE));
592
593 /* set up @_ */
594 av_clear (defav);
595 av_fill (defav, items - 1);
596 while (items--)
597 av_store (defav, items, SvREFCNT_inc (ST(items)));
598
599 mg_get (returnstk); /* isn't documentation wrong for mg_get? */
600 sv = av_pop ((AV *)SvRV (returnstk));
601 prev = (struct coro *)SvIV ((SV*)SvRV (*av_fetch ((AV *)SvRV (sv), 0, 0)));
602 next = (struct coro *)SvIV ((SV*)SvRV (*av_fetch ((AV *)SvRV (sv), 1, 0)));
603 SvREFCNT_dec (sv);
604 transfer(prev, next, 0);
605

Diff Legend

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