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.98 by root, Sun Nov 26 21:25:53 2006 UTC vs.
Revision 1.107 by root, Mon Nov 27 02:15:51 2006 UTC

4#include "perl.h" 4#include "perl.h"
5#include "XSUB.h" 5#include "XSUB.h"
6 6
7#include "patchlevel.h" 7#include "patchlevel.h"
8 8
9#if PERL_VERSION < 6 9#if USE_VALGRIND
10# include <valgrind/valgrind.h>
11#endif
12
13#define PERL_VERSION_ATLEAST(a,b,c) \
14 (PERL_REVISION > (a) \
15 || (PERL_REVISION == (a) \
16 && (PERL_VERSION > (b) \
17 || (PERL_VERSION == (b) && PERLSUBVERSION >= (c)))))
18
19#if !PERL_VERSION_ATLEAST (5,6,0)
10# ifndef PL_ppaddr 20# ifndef PL_ppaddr
11# define PL_ppaddr ppaddr 21# define PL_ppaddr ppaddr
12# endif 22# endif
13# ifndef call_sv 23# ifndef call_sv
14# define call_sv perl_call_sv 24# define call_sv perl_call_sv
52# ifndef PAGESIZE 62# ifndef PAGESIZE
53# define PAGESIZE pagesize 63# define PAGESIZE pagesize
54# define BOOT_PAGESIZE pagesize = sysconf (_SC_PAGESIZE) 64# define BOOT_PAGESIZE pagesize = sysconf (_SC_PAGESIZE)
55static long pagesize; 65static long pagesize;
56# else 66# else
57# define BOOT_PAGESIZE 67# define BOOT_PAGESIZE (void)0
58# endif 68# endif
69#else
70# define PAGESIZE 0
71# define BOOT_PAGESIZE (void)0
59#endif 72#endif
60 73
61/* The next macro should declare a variable stacklevel that contains and approximation 74/* The next macro should declare a variable stacklevel that contains and approximation
62 * to the current C stack pointer. Its property is that it changes with each call 75 * to the current C stack pointer. Its property is that it changes with each call
63 * and should be unique. */ 76 * and should be unique. */
64#define dSTACKLEVEL int stacklevel 77#define dSTACKLEVEL int stacklevel
65#define STACKLEVEL ((void *)&stacklevel) 78#define STACKLEVEL ((void *)&stacklevel)
66 79
67#define IN_DESTRUCT (PL_main_cv == Nullcv) 80#define IN_DESTRUCT (PL_main_cv == Nullcv)
81
82#if __GNUC__ >= 3
83# define attribute(x) __attribute__(x)
84#else
85# define attribute(x)
86#endif
87
88#define NOINLINE attribute ((noinline))
68 89
69#include "CoroAPI.h" 90#include "CoroAPI.h"
70 91
71#define TRANSFER_SET_STACKLEVEL 0x8bfbfbfb /* magic cookie */ 92#define TRANSFER_SET_STACKLEVEL 0x8bfbfbfb /* magic cookie */
72 93
82static struct CoroAPI coroapi; 103static struct CoroAPI coroapi;
83static AV *main_mainstack; /* used to differentiate between $main and others */ 104static AV *main_mainstack; /* used to differentiate between $main and others */
84static HV *coro_state_stash, *coro_stash; 105static HV *coro_state_stash, *coro_stash;
85static SV *coro_mortal; /* will be freed after next transfer */ 106static SV *coro_mortal; /* will be freed after next transfer */
86 107
108static struct coro_cctx *cctx_first;
109static int cctx_count, cctx_idle;
110
87/* this is a structure representing a c-level coroutine */ 111/* this is a structure representing a c-level coroutine */
88typedef struct coro_stack { 112typedef struct coro_cctx {
89 struct coro_stack *next; 113 struct coro_cctx *next;
90 114
91 /* the stack */ 115 /* the stack */
92 void *sptr; 116 void *sptr;
93 long ssize; /* positive == mmap, otherwise malloc */ 117 long ssize; /* positive == mmap, otherwise malloc */
94 118
95 /* cpu state */ 119 /* cpu state */
96 void *idle_sp; /* sp of top-level transfer/schedule/cede call */ 120 void *idle_sp; /* sp of top-level transfer/schedule/cede call */
97 JMPENV *top_env; 121 JMPENV *top_env;
98 coro_context cctx; 122 coro_context cctx;
99} coro_stack; 123
124#if USE_VALGRIND
125 int valgrind_id;
126#endif
127} coro_cctx;
100 128
101/* this is a structure representing a perl-level coroutine */ 129/* this is a structure representing a perl-level coroutine */
102struct coro { 130struct coro {
103 /* the c coroutine allocated to this perl coroutine, if any */ 131 /* the c coroutine allocated to this perl coroutine, if any */
104 coro_stack *stack; 132 coro_cctx *cctx;
105 133
106 /* data associated with this coroutine (initial args) */ 134 /* data associated with this coroutine (initial args) */
107 AV *args; 135 AV *args;
108 int refcnt; 136 int refcnt;
109 137
159 AV *padlist = CvPADLIST (cv); 187 AV *padlist = CvPADLIST (cv);
160 AV *newpadlist, *newpad; 188 AV *newpadlist, *newpad;
161 189
162 newpadlist = newAV (); 190 newpadlist = newAV ();
163 AvREAL_off (newpadlist); 191 AvREAL_off (newpadlist);
164#if PERL_VERSION < 9 192#if PERL_VERSION_ATLEAST (5,9,0)
193 Perl_pad_push (aTHX_ padlist, AvFILLp (padlist) + 1);
194#else
165 Perl_pad_push (aTHX_ padlist, AvFILLp (padlist) + 1, 1); 195 Perl_pad_push (aTHX_ padlist, AvFILLp (padlist) + 1, 1);
166#else
167 Perl_pad_push (aTHX_ padlist, AvFILLp (padlist) + 1);
168#endif 196#endif
169 newpad = (AV *)AvARRAY (padlist)[AvFILLp (padlist)]; 197 newpad = (AV *)AvARRAY (padlist)[AvFILLp (padlist)];
170 --AvFILLp (padlist); 198 --AvFILLp (padlist);
171 199
172 av_store (newpadlist, 0, SvREFCNT_inc (*av_fetch (padlist, 0, FALSE))); 200 av_store (newpadlist, 0, SvREFCNT_inc (*av_fetch (padlist, 0, FALSE)));
291 PL_scopestack_ix = c->scopestack_ix; 319 PL_scopestack_ix = c->scopestack_ix;
292 PL_scopestack_max = c->scopestack_max; 320 PL_scopestack_max = c->scopestack_max;
293 PL_savestack = c->savestack; 321 PL_savestack = c->savestack;
294 PL_savestack_ix = c->savestack_ix; 322 PL_savestack_ix = c->savestack_ix;
295 PL_savestack_max = c->savestack_max; 323 PL_savestack_max = c->savestack_max;
296#if PERL_VERSION < 9 324#if !PERL_VERSION_ATLEAST (5,9,0)
297 PL_retstack = c->retstack; 325 PL_retstack = c->retstack;
298 PL_retstack_ix = c->retstack_ix; 326 PL_retstack_ix = c->retstack_ix;
299 PL_retstack_max = c->retstack_max; 327 PL_retstack_max = c->retstack_max;
300#endif 328#endif
301 PL_curpm = c->curpm; 329 PL_curpm = c->curpm;
418 c->scopestack_ix = PL_scopestack_ix; 446 c->scopestack_ix = PL_scopestack_ix;
419 c->scopestack_max = PL_scopestack_max; 447 c->scopestack_max = PL_scopestack_max;
420 c->savestack = PL_savestack; 448 c->savestack = PL_savestack;
421 c->savestack_ix = PL_savestack_ix; 449 c->savestack_ix = PL_savestack_ix;
422 c->savestack_max = PL_savestack_max; 450 c->savestack_max = PL_savestack_max;
423#if PERL_VERSION < 9 451#if !PERL_VERSION_ATLEAST (5,9,0)
424 c->retstack = PL_retstack; 452 c->retstack = PL_retstack;
425 c->retstack_ix = PL_retstack_ix; 453 c->retstack_ix = PL_retstack_ix;
426 c->retstack_max = PL_retstack_max; 454 c->retstack_max = PL_retstack_max;
427#endif 455#endif
428 c->curpm = PL_curpm; 456 c->curpm = PL_curpm;
436 * not usually need a lot of stackspace. 464 * not usually need a lot of stackspace.
437 */ 465 */
438static void 466static void
439coro_init_stacks () 467coro_init_stacks ()
440{ 468{
441 LOCK;
442
443 PL_curstackinfo = new_stackinfo(96, 1024/sizeof(PERL_CONTEXT) - 1); 469 PL_curstackinfo = new_stackinfo(96, 1024/sizeof(PERL_CONTEXT) - 1);
444 PL_curstackinfo->si_type = PERLSI_MAIN; 470 PL_curstackinfo->si_type = PERLSI_MAIN;
445 PL_curstack = PL_curstackinfo->si_stack; 471 PL_curstack = PL_curstackinfo->si_stack;
446 PL_mainstack = PL_curstack; /* remember in case we switch stacks */ 472 PL_mainstack = PL_curstack; /* remember in case we switch stacks */
447 473
468 494
469 New(54,PL_savestack,96,ANY); 495 New(54,PL_savestack,96,ANY);
470 PL_savestack_ix = 0; 496 PL_savestack_ix = 0;
471 PL_savestack_max = 96; 497 PL_savestack_max = 96;
472 498
473#if PERL_VERSION < 9 499#if !PERL_VERSION_ATLEAST (5,9,0)
474 New(54,PL_retstack,8,OP*); 500 New(54,PL_retstack,8,OP*);
475 PL_retstack_ix = 0; 501 PL_retstack_ix = 0;
476 PL_retstack_max = 8; 502 PL_retstack_max = 8;
477#endif 503#endif
478
479 UNLOCK;
480} 504}
481 505
482/* 506/*
483 * destroy the stacks, the callchain etc... 507 * destroy the stacks, the callchain etc...
484 */ 508 */
485static void 509static void
486destroy_stacks() 510coro_destroy_stacks ()
487{ 511{
488 if (!IN_DESTRUCT) 512 if (!IN_DESTRUCT)
489 { 513 {
490 /* is this ugly, I ask? */ 514 /* is this ugly, I ask? */
491 LEAVE_SCOPE (0); 515 LEAVE_SCOPE (0);
522 546
523 Safefree (PL_tmps_stack); 547 Safefree (PL_tmps_stack);
524 Safefree (PL_markstack); 548 Safefree (PL_markstack);
525 Safefree (PL_scopestack); 549 Safefree (PL_scopestack);
526 Safefree (PL_savestack); 550 Safefree (PL_savestack);
527#if PERL_VERSION < 9 551#if !PERL_VERSION_ATLEAST (5,9,0)
528 Safefree (PL_retstack); 552 Safefree (PL_retstack);
529#endif 553#endif
530} 554}
531 555
532static void 556static void
533setup_coro (struct coro *coro) 557setup_coro (struct coro *coro)
534{ 558{
535 /* 559 /*
536 * emulate part of the perl startup here. 560 * emulate part of the perl startup here.
537 */ 561 */
538 dTHX;
539 dSP;
540 UNOP myop;
541 SV *sub_init = (SV *)get_cv ("Coro::State::coro_init", FALSE);
542 562
543 coro_init_stacks (); 563 coro_init_stacks ();
564
544 /*PL_curcop = 0;*/ 565 PL_curcop = 0;
545 /*PL_in_eval = PL_in_eval;*/ /* inherit */ 566 PL_in_eval = 0;
567 PL_curpm = 0;
568
569 {
570 dSP;
571 LOGOP myop;
572
573 /* I have no idea why this is needed, but it is */
574 PUSHMARK (SP);
575
546 SvREFCNT_dec (GvAV (PL_defgv)); 576 SvREFCNT_dec (GvAV (PL_defgv));
547 GvAV (PL_defgv) = coro->args; coro->args = 0; 577 GvAV (PL_defgv) = coro->args; coro->args = 0;
548 578
549 SPAGAIN;
550
551 Zero (&myop, 1, UNOP); 579 Zero (&myop, 1, LOGOP);
552 myop.op_next = Nullop; 580 myop.op_next = Nullop;
553 myop.op_flags = OPf_WANT_VOID; 581 myop.op_flags = OPf_WANT_VOID;
554 582
555 PL_op = (OP *)&myop; 583 PL_op = (OP *)&myop;
556 584
557 PUSHMARK(SP); 585 PUSHMARK (SP);
558 XPUSHs (sub_init); 586 XPUSHs ((SV *)get_cv ("Coro::State::_coro_init", FALSE));
559 PUTBACK; 587 PUTBACK;
560 PL_op = PL_ppaddr[OP_ENTERSUB](aTHX); 588 PL_op = PL_ppaddr[OP_ENTERSUB](aTHX);
561 SPAGAIN; 589 SPAGAIN;
562 590
563 ENTER; /* necessary e.g. for dounwind */ 591 ENTER; /* necessary e.g. for dounwind */
592 }
564} 593}
565 594
566static void 595static void
567free_coro_mortal () 596free_coro_mortal ()
568{ 597{
571 SvREFCNT_dec (coro_mortal); 600 SvREFCNT_dec (coro_mortal);
572 coro_mortal = 0; 601 coro_mortal = 0;
573 } 602 }
574} 603}
575 604
605static void NOINLINE
606prepare_cctx (coro_cctx *cctx)
607{
608 dSP;
609 LOGOP myop;
610
611 Zero (&myop, 1, LOGOP);
612 myop.op_next = PL_op;
613 myop.op_flags = OPf_WANT_VOID;
614
615 sv_setiv (get_sv ("Coro::State::_cctx", FALSE), PTR2IV (cctx));
616
617 PUSHMARK (SP);
618 XPUSHs ((SV *)get_cv ("Coro::State::_cctx_init", FALSE));
619 PUTBACK;
620 PL_restartop = PL_ppaddr[OP_ENTERSUB](aTHX);
621 SPAGAIN;
622}
623
576static void 624static void
577coro_run (void *arg) 625coro_run (void *arg)
578{ 626{
627 /* coro_run is the alternative epilogue of transfer() */
628 UNLOCK;
629
579 /* 630 /*
580 * this is a _very_ stripped down perl interpreter ;) 631 * this is a _very_ stripped down perl interpreter ;)
581 */ 632 */
582 dTHX;
583 int ret;
584
585 UNLOCK;
586
587 PL_top_env = &PL_start_env; 633 PL_top_env = &PL_start_env;
588 634
589 sv_setiv (get_sv ("Coro::State::cctx_stack", FALSE), PTR2IV ((coro_stack *)arg)); 635 /* inject call to cctx_init */
590 sv_setiv (get_sv ("Coro::State::cctx_restartop", FALSE), PTR2IV (PL_op)); 636 prepare_cctx ((coro_cctx *)arg);
591
592 /* continue at cctx_init, without entersub */
593 PL_restartop = CvSTART (get_cv ("Coro::State::cctx_init", FALSE));
594 637
595 /* somebody will hit me for both perl_run and PL_restartop */ 638 /* somebody will hit me for both perl_run and PL_restartop */
596 ret = perl_run (PERL_GET_CONTEXT); 639 perl_run (PL_curinterp);
597 printf ("ret %d\n", ret);//D
598 640
599 fputs ("FATAL: C coroutine fell over the edge of the world, aborting.\n", stderr); 641 fputs ("FATAL: C coroutine fell over the edge of the world, aborting. Did you call exit in a coroutine?\n", stderr);
600 abort (); 642 abort ();
601} 643}
602 644
603static coro_stack * 645static coro_cctx *
604stack_new () 646cctx_new ()
605{ 647{
606 coro_stack *stack; 648 coro_cctx *cctx;
607 649
650 ++cctx_count;
651
608 New (0, stack, 1, coro_stack); 652 New (0, cctx, 1, coro_cctx);
609 653
610#if HAVE_MMAP 654#if HAVE_MMAP
611 655
612 stack->ssize = ((STACKSIZE * sizeof (long) + PAGESIZE - 1) / PAGESIZE + STACKGUARD) * PAGESIZE; 656 cctx->ssize = ((STACKSIZE * sizeof (long) + PAGESIZE - 1) / PAGESIZE + STACKGUARD) * PAGESIZE;
613 /* mmap suppsedly does allocate-on-write for us */ 657 /* mmap suppsedly does allocate-on-write for us */
614 stack->sptr = mmap (0, stack->ssize, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_PRIVATE|MAP_ANONYMOUS, 0, 0); 658 cctx->sptr = mmap (0, cctx->ssize, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_PRIVATE|MAP_ANONYMOUS, 0, 0);
615 659
616 if (stack->sptr == (void *)-1) 660 if (cctx->sptr == (void *)-1)
617 { 661 {
618 perror ("FATAL: unable to mmap stack for coroutine"); 662 perror ("FATAL: unable to mmap stack for coroutine");
619 _exit (EXIT_FAILURE); 663 _exit (EXIT_FAILURE);
620 } 664 }
621 665
622# if STACKGUARD 666# if STACKGUARD
623 mprotect (stack->sptr, STACKGUARD * PAGESIZE, PROT_NONE); 667 mprotect (cctx->sptr, STACKGUARD * PAGESIZE, PROT_NONE);
624# endif 668# endif
625 669
626#else 670#else
627 671
628 stack->ssize = STACKSIZE * (long)sizeof (long); 672 cctx->ssize = STACKSIZE * (long)sizeof (long);
629 New (0, stack->sptr, STACKSIZE, long); 673 New (0, cctx->sptr, STACKSIZE, long);
630 674
631 if (!stack->sptr) 675 if (!cctx->sptr)
632 { 676 {
633 perror (stderr, "FATAL: unable to malloc stack for coroutine"); 677 perror ("FATAL: unable to malloc stack for coroutine");
634 _exit (EXIT_FAILURE); 678 _exit (EXIT_FAILURE);
635 } 679 }
636 680
637#endif 681#endif
638 682
683#if USE_VALGRIND
684 cctx->valgrind_id = VALGRIND_STACK_REGISTER (
685 STACKGUARD * PAGESIZE + (char *)cctx->sptr,
686 cctx->ssize + (char *)cctx->sptr
687 );
688#endif
689
639 coro_create (&stack->cctx, coro_run, (void *)stack, stack->sptr, stack->ssize); 690 coro_create (&cctx->cctx, coro_run, (void *)cctx, cctx->sptr, cctx->ssize);
640 691
641 return stack; 692 return cctx;
642} 693}
643 694
644static void 695static void
645stack_free (coro_stack *stack) 696cctx_free (coro_cctx *cctx)
646{ 697{
647 if (!stack) 698 if (!cctx)
648 return; 699 return;
649 700
701 --cctx_count;
702
703#if USE_VALGRIND
704 VALGRIND_STACK_DEREGISTER (cctx->valgrind_id);
705#endif
706
650#if HAVE_MMAP 707#if HAVE_MMAP
651 munmap (stack->sptr, stack->ssize); 708 munmap (cctx->sptr, cctx->ssize);
652#else 709#else
653 Safefree (stack->sptr); 710 Safefree (cctx->sptr);
654#endif 711#endif
655 712
656 Safefree (stack); 713 Safefree (cctx);
657} 714}
658 715
659static coro_stack *stack_first;
660
661static coro_stack * 716static coro_cctx *
662stack_get () 717cctx_get ()
663{ 718{
664 coro_stack *stack; 719 coro_cctx *cctx;
665 720
666 if (stack_first) 721 if (cctx_first)
667 { 722 {
668 stack = stack_first; 723 --cctx_idle;
724 cctx = cctx_first;
669 stack_first = stack->next; 725 cctx_first = cctx->next;
670 } 726 }
671 else 727 else
672 { 728 {
673 stack = stack_new (); 729 cctx = cctx_new ();
674 PL_op = PL_op->op_next; 730 PL_op = PL_op->op_next;
675 } 731 }
676 732
677 return stack; 733 return cctx;
678} 734}
679 735
680static void 736static void
681stack_put (coro_stack *stack) 737cctx_put (coro_cctx *cctx)
682{ 738{
683 stack->next = stack_first; 739 ++cctx_idle;
684 stack_first = stack; 740 cctx->next = cctx_first;
741 cctx_first = cctx;
685} 742}
686 743
687/* never call directly, always through the coro_state_transfer global variable */ 744/* never call directly, always through the coro_state_transfer global variable */
688static void 745static void NOINLINE
689transfer_impl (struct coro *prev, struct coro *next, int flags) 746transfer (struct coro *prev, struct coro *next, int flags)
690{ 747{
691 dSTACKLEVEL; 748 dSTACKLEVEL;
692 749
693 /* sometimes transfer is only called to set idle_sp */ 750 /* sometimes transfer is only called to set idle_sp */
694 if (flags == TRANSFER_SET_STACKLEVEL) 751 if (flags == TRANSFER_SET_STACKLEVEL)
695 ((coro_stack *)prev)->idle_sp = STACKLEVEL; 752 ((coro_cctx *)prev)->idle_sp = STACKLEVEL;
696 else if (prev != next) 753 else if (prev != next)
697 { 754 {
698 coro_stack *prev__stack; 755 coro_cctx *prev__cctx;
699 756
700 LOCK; 757 LOCK;
701 758
702 if (next->mainstack) 759 if (next->mainstack)
703 { 760 {
711 /* first get rid of the old state */ 768 /* first get rid of the old state */
712 SAVE (prev, -1); 769 SAVE (prev, -1);
713 /* setup coroutine call */ 770 /* setup coroutine call */
714 setup_coro (next); 771 setup_coro (next);
715 /* need a stack */ 772 /* need a stack */
716 next->stack = 0; 773 next->cctx = 0;
717 } 774 }
718 775
719 if (!prev->stack) 776 if (!prev->cctx)
720 /* create a new empty context */ 777 /* create a new empty context */
721 Newz (0, prev->stack, 1, coro_stack); 778 Newz (0, prev->cctx, 1, coro_cctx);
722 779
723 prev__stack = prev->stack; 780 prev__cctx = prev->cctx;
724 781
725 /* possibly "free" the stack */ 782 /* possibly "free" the cctx */
726 if (prev__stack->idle_sp == STACKLEVEL) 783 if (prev__cctx->idle_sp == STACKLEVEL)
727 { 784 {
728 stack_put (prev__stack); 785 cctx_put (prev__cctx);
729 prev->stack = 0; 786 prev->cctx = 0;
730 } 787 }
731 788
732 if (!next->stack) 789 if (!next->cctx)
733 next->stack = stack_get (); 790 next->cctx = cctx_get ();
734 791
735 if (prev__stack != next->stack) 792 if (prev__cctx != next->cctx)
736 { 793 {
737 prev__stack->top_env = PL_top_env; 794 prev__cctx->top_env = PL_top_env;
738 PL_top_env = next->stack->top_env; 795 PL_top_env = next->cctx->top_env;
739 coro_transfer (&prev__stack->cctx, &next->stack->cctx); 796 coro_transfer (&prev__cctx->cctx, &next->cctx->cctx);
740 } 797 }
741 798
742 free_coro_mortal (); 799 free_coro_mortal ();
743 800
744 UNLOCK; 801 UNLOCK;
745 } 802 }
746} 803}
747
748/* use this function pointer to call the above function */
749/* this is done to increase chances of the compiler not inlining the call */
750/* not static to make it even harder for the compiler (and theoretically impossible in most cases */
751void (*coro_state_transfer)(struct coro *prev, struct coro *next, int flags) = transfer_impl;
752 804
753struct transfer_args 805struct transfer_args
754{ 806{
755 struct coro *prev, *next; 807 struct coro *prev, *next;
756 int flags; 808 int flags;
757}; 809};
758 810
759#define TRANSFER(ta) coro_state_transfer ((ta).prev, (ta).next, (ta).flags) 811#define TRANSFER(ta) transfer ((ta).prev, (ta).next, (ta).flags)
760 812
761static void 813static void
762coro_state_destroy (struct coro *coro) 814coro_state_destroy (struct coro *coro)
763{ 815{
764 if (coro->refcnt--) 816 if (coro->refcnt--)
769 struct coro temp; 821 struct coro temp;
770 822
771 SAVE ((&temp), TRANSFER_SAVE_ALL); 823 SAVE ((&temp), TRANSFER_SAVE_ALL);
772 LOAD (coro); 824 LOAD (coro);
773 825
774 destroy_stacks (); 826 coro_destroy_stacks ();
775 827
776 LOAD ((&temp)); /* this will get rid of defsv etc.. */ 828 LOAD ((&temp)); /* this will get rid of defsv etc.. */
777 829
778 coro->mainstack = 0; 830 coro->mainstack = 0;
779 } 831 }
780 832
781 stack_free (coro->stack); 833 cctx_free (coro->cctx);
782 SvREFCNT_dec (coro->args); 834 SvREFCNT_dec (coro->args);
783 Safefree (coro); 835 Safefree (coro);
784} 836}
785 837
786static int 838static int
802 ++coro->refcnt; 854 ++coro->refcnt;
803 855
804 return 0; 856 return 0;
805} 857}
806 858
807static MGVTBL coro_state_vtbl = { 0, 0, 0, 0, coro_state_clear, 0, coro_state_dup, 0 }; 859static MGVTBL coro_state_vtbl = {
860 0, 0, 0, 0,
861 coro_state_clear,
862 0,
863#ifdef MGf_DUP
864 coro_state_dup,
865#else
866# define MGf_DUP 0
867#endif
868};
808 869
809static struct coro * 870static struct coro *
810SvSTATE (SV *coro) 871SvSTATE (SV *coro)
811{ 872{
812 HV *stash; 873 HV *stash;
909static void 970static void
910prepare_schedule (struct transfer_args *ta) 971prepare_schedule (struct transfer_args *ta)
911{ 972{
912 SV *current, *prev, *next; 973 SV *current, *prev, *next;
913 974
914 LOCK;
915
916 current = GvSV (coro_current); 975 current = GvSV (coro_current);
917 976
918 for (;;) 977 for (;;)
919 { 978 {
920 LOCK; 979 LOCK;
921
922 next = coro_deq (PRIO_MIN); 980 next = coro_deq (PRIO_MIN);
981 UNLOCK;
923 982
924 if (next) 983 if (next)
925 break; 984 break;
926
927 UNLOCK;
928 985
929 { 986 {
930 dSP; 987 dSP;
931 988
932 ENTER; 989 ENTER;
943 1000
944 prev = SvRV (current); 1001 prev = SvRV (current);
945 SvRV (current) = next; 1002 SvRV (current) = next;
946 1003
947 /* free this only after the transfer */ 1004 /* free this only after the transfer */
1005 LOCK;
948 free_coro_mortal (); 1006 free_coro_mortal ();
1007 UNLOCK;
949 coro_mortal = prev; 1008 coro_mortal = prev;
950 1009
951 ta->prev = SvSTATE (prev); 1010 ta->prev = SvSTATE (prev);
952 ta->next = SvSTATE (next); 1011 ta->next = SvSTATE (next);
953 ta->flags = TRANSFER_SAVE_ALL; 1012 ta->flags = TRANSFER_SAVE_ALL;
954
955 UNLOCK;
956} 1013}
957 1014
958static void 1015static void
959prepare_cede (struct transfer_args *ta) 1016prepare_cede (struct transfer_args *ta)
960{ 1017{
1025 sv_magicext ((SV *)hv, 0, PERL_MAGIC_ext, &coro_state_vtbl, (char *)coro, 0)->mg_flags |= MGf_DUP; 1082 sv_magicext ((SV *)hv, 0, PERL_MAGIC_ext, &coro_state_vtbl, (char *)coro, 0)->mg_flags |= MGf_DUP;
1026 RETVAL = sv_bless (newRV_noinc ((SV *)hv), gv_stashpv (klass, 1)); 1083 RETVAL = sv_bless (newRV_noinc ((SV *)hv), gv_stashpv (klass, 1));
1027 1084
1028 for (i = 1; i < items; i++) 1085 for (i = 1; i < items; i++)
1029 av_push (coro->args, newSVsv (ST (i))); 1086 av_push (coro->args, newSVsv (ST (i)));
1030
1031 /*coro->mainstack = 0; *//*actual work is done inside transfer */
1032 /*coro->stack = 0;*/
1033} 1087}
1034 OUTPUT: 1088 OUTPUT:
1035 RETVAL 1089 RETVAL
1036 1090
1037void 1091void
1046 struct transfer_args ta; 1100 struct transfer_args ta;
1047 1101
1048 switch (ix) 1102 switch (ix)
1049 { 1103 {
1050 case 0: 1104 case 0:
1051 ta.prev = (struct coro *)INT2PTR (coro_stack *, SvIV (ST (0))); 1105 ta.prev = (struct coro *)INT2PTR (coro_cctx *, SvIV (ST (0)));
1052 ta.next = 0; 1106 ta.next = 0;
1053 ta.flags = TRANSFER_SET_STACKLEVEL; 1107 ta.flags = TRANSFER_SET_STACKLEVEL;
1054 break; 1108 break;
1055 1109
1056 case 1: 1110 case 1:
1110 ++coro_src->refcnt; 1164 ++coro_src->refcnt;
1111 sv_magicext (SvRV (dst), 0, PERL_MAGIC_ext, &coro_state_vtbl, (char *)coro_src, 0)->mg_flags |= MGf_DUP; 1165 sv_magicext (SvRV (dst), 0, PERL_MAGIC_ext, &coro_state_vtbl, (char *)coro_src, 0)->mg_flags |= MGf_DUP;
1112} 1166}
1113 1167
1114void 1168void
1115_nonlocal_goto (IV nextop)
1116 CODE:
1117 /* uuh, somebody will kill me again for this */
1118 PL_op->op_next = INT2PTR (OP *, nextop);
1119
1120void
1121_exit (code) 1169_exit (code)
1122 int code 1170 int code
1123 PROTOTYPE: $ 1171 PROTOTYPE: $
1124 CODE: 1172 CODE:
1125 _exit (code); 1173 _exit (code);
1174
1175int
1176cctx_count ()
1177 CODE:
1178 RETVAL = cctx_count;
1179 OUTPUT:
1180 RETVAL
1181
1182int
1183cctx_idle ()
1184 CODE:
1185 RETVAL = cctx_idle;
1186 OUTPUT:
1187 RETVAL
1126 1188
1127MODULE = Coro::State PACKAGE = Coro 1189MODULE = Coro::State PACKAGE = Coro
1128 1190
1129BOOT: 1191BOOT:
1130{ 1192{

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines