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.87 by root, Fri Nov 24 13:40:36 2006 UTC vs.
Revision 1.93 by root, Sun Nov 26 03:22:50 2006 UTC

… …
27# ifndef IS_PADCONST 27# ifndef IS_PADCONST
28# define IS_PADCONST(v) 0 28# define IS_PADCONST(v) 0
29# endif 29# endif
30#endif 30#endif
31 31
32#include <stdio.h>
32#include <errno.h> 33#include <errno.h>
33 34
34#if !__i386 && !__x86_64 && !__powerpc && !__m68k && !__alpha && !__mips && !__sparc64 35#if !__i386 && !__x86_64 && !__powerpc && !__m68k && !__alpha && !__mips && !__sparc64
35# undef STACKGUARD 36# undef STACKGUARD
36#endif 37#endif
… …
57# else 58# else
58# define BOOT_PAGESIZE 59# define BOOT_PAGESIZE
59# endif 60# endif
60#endif 61#endif
61 62
62#define SUB_INIT "Coro::State::initialize"
63#define UCORO_STATE "_coro_state"
64
65/* The next macro should declare a variable stacklevel that contains and approximation 63/* The next macro should declare a variable stacklevel that contains and approximation
66 * to the current C stack pointer. Its property is that it changes with each call 64 * to the current C stack pointer. Its property is that it changes with each call
67 * and should be unique. */ 65 * and should be unique. */
66#define dSTACKLEVEL int stacklevel
68#define dSTACKLEVEL void *stacklevel = &stacklevel 67#define STACKLEVEL ((void *)&stacklevel)
69 68
70#define IN_DESTRUCT (PL_main_cv == Nullcv) 69#define IN_DESTRUCT (PL_main_cv == Nullcv)
71 70
72#define labs(l) ((l) >= 0 ? (l) : -(l)) 71#define labs(l) ((l) >= 0 ? (l) : -(l))
73 72
74#include "CoroAPI.h" 73#include "CoroAPI.h"
74
75#define TRANSFER_SET_STACKLEVEL 0x8bfbfbfb /* magic cookie */
75 76
76#ifdef USE_ITHREADS 77#ifdef USE_ITHREADS
77static perl_mutex coro_mutex; 78static perl_mutex coro_mutex;
78# define LOCK do { MUTEX_LOCK (&coro_mutex); } while (0) 79# define LOCK do { MUTEX_LOCK (&coro_mutex); } while (0)
79# define UNLOCK do { MUTEX_UNLOCK (&coro_mutex); } while (0) 80# define UNLOCK do { MUTEX_UNLOCK (&coro_mutex); } while (0)
… …
82# define UNLOCK (void)0 83# define UNLOCK (void)0
83#endif 84#endif
84 85
85static struct CoroAPI coroapi; 86static struct CoroAPI coroapi;
86static AV *main_mainstack; /* used to differentiate between $main and others */ 87static AV *main_mainstack; /* used to differentiate between $main and others */
87static HV *coro_state_stash; 88static HV *coro_state_stash, *coro_stash;
88static SV *ucoro_state_sv;
89static U32 ucoro_state_hash;
90static SV *coro_mortal; /* will be freed after next transfer */ 89static SV *coro_mortal; /* will be freed after next transfer */
91 90
92/* this is actually not only the c stack but also c registers etc... */ 91/* this is a structure representing a c-level coroutine */
93typedef struct { 92typedef struct coro_stack {
94 int refcnt; /* pointer reference counter */ 93 struct coro_stack *next;
95 int usecnt; /* shared by how many coroutines */
96 int gencnt; /* generation counter */
97 94
98 coro_context cctx; 95 /* the stack */
99
100 void *sptr; 96 void *sptr;
101 long ssize; /* positive == mmap, otherwise malloc */ 97 long ssize; /* positive == mmap, otherwise malloc */
98
99 /* cpu state */
100 void *idle_sp; /* original stacklevel when coroutine was created */
101 JMPENV *top_env;
102 coro_context cctx;
102} coro_stack; 103} coro_stack;
103 104
105/* the (fake) coro_stack representing the main program */
106static coro_stack *main_stack;
107
108/* this is a structure representing a perl-level coroutine */
104struct coro { 109struct coro {
105 /* the optional C context */ 110 /* the c coroutine allocated to this perl coroutine, if any */
106 coro_stack *stack; 111 coro_stack *stack;
107 void *cursp; 112
113 /* data associated with this coroutine (initial args) */
114 AV *args;
108 int gencnt; 115 int refcnt;
109 116
110 /* optionally saved, might be zero */ 117 /* optionally saved, might be zero */
111 AV *defav; 118 AV *defav;
112 SV *defsv; 119 SV *defsv;
113 SV *errsv; 120 SV *errsv;
… …
143 OP **retstack; 150 OP **retstack;
144 I32 retstack_ix; 151 I32 retstack_ix;
145 I32 retstack_max; 152 I32 retstack_max;
146 PMOP *curpm; 153 PMOP *curpm;
147 COP *curcop; 154 COP *curcop;
148 JMPENV *top_env;
149 155
150 /* coro process data */ 156 /* coro process data */
151 int prio; 157 int prio;
152
153 /* data associated with this coroutine (initial args) */
154 AV *args;
155 int refcnt;
156}; 158};
157 159
158typedef struct coro *Coro__State; 160typedef struct coro *Coro__State;
159typedef struct coro *Coro__State_or_hashref; 161typedef struct coro *Coro__State_or_hashref;
160 162
… …
303 PL_retstack_ix = c->retstack_ix; 305 PL_retstack_ix = c->retstack_ix;
304 PL_retstack_max = c->retstack_max; 306 PL_retstack_max = c->retstack_max;
305#endif 307#endif
306 PL_curpm = c->curpm; 308 PL_curpm = c->curpm;
307 PL_curcop = c->curcop; 309 PL_curcop = c->curcop;
308 PL_top_env = c->top_env;
309 310
310 if (c->defav) REPLACE_SV (GvAV (PL_defgv), c->defav); 311 if (c->defav) REPLACE_SV (GvAV (PL_defgv), c->defav);
311 if (c->defsv) REPLACE_SV (DEFSV , c->defsv); 312 if (c->defsv) REPLACE_SV (DEFSV , c->defsv);
312 if (c->errsv) REPLACE_SV (ERRSV , c->errsv); 313 if (c->errsv) REPLACE_SV (ERRSV , c->errsv);
313 314
… …
431 c->retstack_ix = PL_retstack_ix; 432 c->retstack_ix = PL_retstack_ix;
432 c->retstack_max = PL_retstack_max; 433 c->retstack_max = PL_retstack_max;
433#endif 434#endif
434 c->curpm = PL_curpm; 435 c->curpm = PL_curpm;
435 c->curcop = PL_curcop; 436 c->curcop = PL_curcop;
436 c->top_env = PL_top_env;
437} 437}
438 438
439/* 439/*
440 * allocate various perl stacks. This is an exact copy 440 * allocate various perl stacks. This is an exact copy
441 * of perl.c:init_stacks, except that it uses less memory 441 * of perl.c:init_stacks, except that it uses less memory
… …
535 Safefree (PL_retstack); 535 Safefree (PL_retstack);
536#endif 536#endif
537} 537}
538 538
539static void 539static void
540allocate_stack (Coro__State ctx, int alloc) 540setup_coro (struct coro *coro)
541{
542 coro_stack *stack;
543
544 New (0, stack, 1, coro_stack);
545
546 stack->refcnt = 1;
547 stack->usecnt = 1;
548 stack->gencnt = ctx->gencnt = 0;
549
550 if (alloc)
551 {
552#if HAVE_MMAP
553 stack->ssize = ((STACKSIZE * sizeof (long) + PAGESIZE - 1) / PAGESIZE + STACKGUARD) * PAGESIZE; /* mmap should do allocate-on-write for us */
554 stack->sptr = mmap (0, stack->ssize, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_PRIVATE|MAP_ANONYMOUS, 0, 0);
555 if (stack->sptr != (void *)-1)
556 {
557# if STACKGUARD
558 mprotect (stack->sptr, STACKGUARD * PAGESIZE, PROT_NONE);
559# endif
560 }
561 else
562#endif
563 {
564 stack->ssize = - (STACKSIZE * (long)sizeof (long));
565 New (0, stack->sptr, STACKSIZE, long);
566 }
567 }
568 else
569 stack->sptr = 0;
570
571 ctx->stack = stack;
572}
573
574static void
575deallocate_stack (Coro__State ctx)
576{
577 coro_stack *stack = ctx->stack;
578
579 ctx->stack = 0;
580
581 if (stack)
582 {
583 if (!--stack->refcnt)
584 {
585#ifdef HAVE_MMAP
586 if (stack->ssize > 0 && stack->sptr)
587 munmap (stack->sptr, stack->ssize);
588 else
589#endif
590 Safefree (stack->sptr);
591
592 Safefree (stack);
593 }
594 else if (ctx->gencnt == stack->gencnt)
595 --stack->usecnt;
596 }
597}
598
599static void
600setup_coro (void *arg)
601{ 541{
602 /* 542 /*
603 * emulate part of the perl startup here. 543 * emulate part of the perl startup here.
604 */ 544 */
605 dTHX; 545 dTHX;
606 dSP; 546 dSP;
607 Coro__State ctx = (Coro__State)arg; 547 UNOP myop;
608 SV *sub_init = (SV *)get_cv (SUB_INIT, FALSE); 548 SV *sub_init = (SV *)get_cv ("Coro::State::coro_init", FALSE);
609 549
610 coro_init_stacks (aTHX); 550 coro_init_stacks (aTHX);
611 /*PL_curcop = 0;*/ 551 /*PL_curcop = 0;*/
612 /*PL_in_eval = PL_in_eval;*/ /* inherit */ 552 /*PL_in_eval = PL_in_eval;*/ /* inherit */
613 SvREFCNT_dec (GvAV (PL_defgv)); 553 SvREFCNT_dec (GvAV (PL_defgv));
614 GvAV (PL_defgv) = ctx->args; ctx->args = 0; 554 GvAV (PL_defgv) = coro->args; coro->args = 0;
615 555
616 SPAGAIN; 556 SPAGAIN;
617 557
618 if (ctx->stack)
619 {
620 ctx->cursp = 0;
621
622 PUSHMARK(SP);
623 PUTBACK;
624 (void) call_sv (sub_init, G_VOID|G_NOARGS|G_EVAL);
625
626 if (SvTRUE (ERRSV))
627 croak (NULL);
628 else
629 croak ("FATAL: CCTXT coroutine returned!");
630 }
631 else
632 {
633 UNOP myop;
634
635 Zero(&myop, 1, UNOP); 558 Zero (&myop, 1, UNOP);
636 myop.op_next = Nullop; 559 myop.op_next = Nullop;
637 myop.op_flags = OPf_WANT_VOID; 560 myop.op_flags = OPf_WANT_VOID;
638 561
639 PL_op = (OP *)&myop; 562 PL_op = (OP *)&myop;
640 563
641 PUSHMARK(SP); 564 PUSHMARK(SP);
642 XPUSHs (sub_init); 565 XPUSHs (sub_init);
643 /*
644 * the next line is slightly wrong, as PL_op->op_next
645 * is actually being executed so we skip the first op.
646 * that doesn't matter, though, since it is only
647 * pp_nextstate and we never return...
648 * ah yes, and I don't care anyways ;)
649 */
650 PUTBACK; 566 PUTBACK;
651 PL_op = PL_ppaddr[OP_ENTERSUB](aTHX); 567 PL_op = PL_ppaddr[OP_ENTERSUB](aTHX);
652 SPAGAIN; 568 SPAGAIN;
653 569
654 ENTER; /* necessary e.g. for dounwind */ 570 ENTER; /* necessary e.g. for dounwind */
655 }
656} 571}
657 572
658static void 573static void
659continue_coro (void *arg) 574free_coro_mortal ()
660{ 575{
661 /*
662 * this is a _very_ stripped down perl interpreter ;)
663 */
664 dTHX;
665 Coro__State ctx = (Coro__State)arg;
666
667 PL_top_env = &PL_start_env;
668
669 ctx->cursp = 0;
670 PL_op = PL_op->op_next;
671 CALLRUNOPS(aTHX);
672
673 abort ();
674}
675
676/* never call directly, always through the coro_state_transfer global variable */
677static void
678transfer_impl (pTHX_ struct coro *prev, struct coro *next, int flags)
679{
680 dSTACKLEVEL;
681
682 if (prev != next)
683 {
684 /* has this coro been created yet? */
685 if (next->mainstack)
686 {
687 LOCK;
688 SAVE (prev, flags);
689 LOAD (next);
690 UNLOCK;
691
692 /* mark this state as in-use */
693 next->mainstack = 0;
694 next->tmps_ix = -2;
695
696 /* stacklevel changed? if yes, grab the stack for us! */
697 if (flags & TRANSFER_SAVE_CCTXT)
698 {
699 if (!prev->stack)
700 allocate_stack (prev, 0);
701 else if (prev->cursp != stacklevel
702 && prev->stack->usecnt > 1)
703 {
704 prev->gencnt = ++prev->stack->gencnt;
705 prev->stack->usecnt = 1;
706 }
707
708 /* has our stack been invalidated? */
709 if (next->stack && next->stack->gencnt != next->gencnt)
710 {
711 deallocate_stack (next);
712 allocate_stack (next, 1);
713 coro_create (&(next->stack->cctx),
714 continue_coro, (void *)next,
715 next->stack->sptr, labs (next->stack->ssize));
716 }
717
718 coro_transfer (&(prev->stack->cctx), &(next->stack->cctx));
719 prev->cursp = stacklevel;
720 /* don't add any code here */
721 }
722 else
723 next->cursp = stacklevel;
724 }
725 else if (next->tmps_ix == -2)
726 croak ("tried to transfer to running coroutine");
727 else
728 {
729 LOCK;
730 SAVE (prev, -1); /* first get rid of the old state */
731 UNLOCK;
732
733 /* create the coroutine for the first time */
734 if (flags & TRANSFER_SAVE_CCTXT)
735 {
736 if (!prev->stack)
737 allocate_stack (prev, 0);
738
739 /* the new coroutine starts with start_env again */
740 PL_top_env = &PL_start_env;
741
742 if (prev->stack->sptr && flags & TRANSFER_LAZY_STACK)
743 {
744 setup_coro (next);
745 next->cursp = stacklevel;
746
747 prev->stack->refcnt++;
748 prev->stack->usecnt++;
749 next->stack = prev->stack;
750 next->gencnt = prev->gencnt;
751 }
752 else
753 {
754 assert (!next->stack);
755 allocate_stack (next, 1);
756 coro_create (&(next->stack->cctx),
757 setup_coro, (void *)next,
758 next->stack->sptr, labs (next->stack->ssize));
759 coro_transfer (&(prev->stack->cctx), &(next->stack->cctx));
760 prev->cursp = stacklevel;
761 /* don't add any code here */
762 }
763 }
764 else
765 {
766 setup_coro (next);
767 next->cursp = stacklevel;
768 }
769 }
770 }
771
772 LOCK;
773 if (coro_mortal) 576 if (coro_mortal)
774 { 577 {
775 SvREFCNT_dec (coro_mortal); 578 SvREFCNT_dec (coro_mortal);
776 coro_mortal = 0; 579 coro_mortal = 0;
777 } 580 }
581}
582
583static void
584coro_run (void *arg)
585{
586 /*
587 * this is a _very_ stripped down perl interpreter ;)
588 */
589 dTHX;
590
778 UNLOCK; 591 UNLOCK;
592
593 PL_top_env = &PL_start_env;
594
595 sv_setiv (get_sv ("Coro::State::cctx_stack", FALSE), PTR2IV ((coro_stack *)arg));
596 sv_setiv (get_sv ("Coro::State::cctx_restartop", FALSE), PTR2IV (PL_op));
597
598 /* continue at cctx_init, without entersub */
599 PL_restartop = CvSTART (get_cv ("Coro::State::cctx_init", FALSE));
600
601 /* somebody will hit me for both perl_run and PL_restart_op */
602 perl_run (aTHX_ PERL_GET_CONTEXT);
603
604 abort ();
605}
606
607static coro_stack *
608stack_new ()
609{
610 coro_stack *stack;
611
612 New (0, stack, 1, coro_stack);
613
614#if HAVE_MMAP
615
616 stack->ssize = ((STACKSIZE * sizeof (long) + PAGESIZE - 1) / PAGESIZE + STACKGUARD) * PAGESIZE; /* mmap should do allocate-on-write for us */
617 stack->sptr = mmap (0, stack->ssize, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_PRIVATE|MAP_ANONYMOUS, 0, 0);
618
619 if (stack->sptr == (void *)-1)
620 {
621 perror ("FATAL: unable to mmap stack for coroutine");
622 _exit (EXIT_FAILURE);
623 }
624
625 mprotect (stack->sptr, STACKGUARD * PAGESIZE, PROT_NONE);
626
627#else
628
629 stack->ssize = STACKSIZE * (long)sizeof (long);
630 New (0, stack->sptr, STACKSIZE, long);
631
632 if (!stack->sptr)
633 {
634 perror (stderr, "FATAL: unable to malloc stack for coroutine");
635 _exit (EXIT_FAILURE);
636 }
637
638#endif
639
640 coro_create (&stack->cctx, coro_run, (void *)stack, stack->sptr, stack->ssize);
641
642 return stack;
643}
644
645static void
646stack_free (coro_stack *stack)
647{
648 if (!stack || stack == main_stack)
649 return;
650
651#if HAVE_MMAP
652 munmap (stack->sptr, stack->ssize);
653#else
654 Safefree (stack->sptr);
655#endif
656
657 Safefree (stack);
658}
659
660static coro_stack *stack_first;
661
662static coro_stack *
663stack_get ()
664{
665 coro_stack *stack;
666
667 if (stack_first)
668 {
669 stack = stack_first;
670 stack_first = stack->next;
671 }
672 else
673 {
674 stack = stack_new ();
675 PL_op = PL_op->op_next;
676 }
677
678 return stack;
679}
680
681static void
682stack_put (coro_stack *stack)
683{
684 stack->next = stack_first;
685 stack_first = stack;
686}
687
688/* never call directly, always through the coro_state_transfer global variable */
689static void
690transfer_impl (pTHX_ struct coro *prev, struct coro *next, int flags)
691{
692 dSTACKLEVEL;
693
694 /* sometimes transfer is only called to set idle_sp */
695 if (flags == TRANSFER_SET_STACKLEVEL)
696 ((coro_stack *)prev)->idle_sp = STACKLEVEL;
697 else if (prev != next)
698 {
699 coro_stack *prev__stack;
700
701 LOCK;
702
703 if (next->mainstack)
704 {
705 /* coroutine already started */
706 SAVE (prev, flags);
707 LOAD (next);
708 }
709 else
710 {
711 /* need to start coroutine */
712 /* first get rid of the old state */
713 SAVE (prev, -1);
714 /* setup coroutine call */
715 setup_coro (next);
716 /* need a stack */
717 next->stack = 0;
718 }
719
720 prev__stack = prev->stack;
721
722 /* possibly "free" the stack */
723 if (prev__stack->idle_sp == STACKLEVEL)
724 {
725 stack_put (prev__stack);
726 prev->stack = 0;
727 }
728
729 if (!next->stack)
730 next->stack = stack_get ();
731
732 if (prev__stack != next->stack)
733 {
734 prev__stack->top_env = PL_top_env;
735 PL_top_env = next->stack->top_env;
736 coro_transfer (&prev__stack->cctx, &next->stack->cctx);
737 }
738
739 free_coro_mortal ();
740
741 UNLOCK;
742 }
779} 743}
780 744
781/* use this function pointer to call the above function */ 745/* use this function pointer to call the above function */
782/* this is done to increase chances of the compiler not inlining the call */ 746/* this is done to increase chances of the compiler not inlining the call */
747/* not static to make it even harder for the compiler (and theoretically impossible in most cases */
783void (*coro_state_transfer)(pTHX_ struct coro *prev, struct coro *next, int flags) = transfer_impl; 748void (*coro_state_transfer)(pTHX_ struct coro *prev, struct coro *next, int flags) = transfer_impl;
784 749
785#define SV_CORO(sv,func) \ 750struct transfer_args
786 do { \ 751{
787 if (SvROK (sv)) \ 752 struct coro *prev, *next;
788 sv = SvRV (sv); \ 753 int flags;
789 \ 754};
790 if (SvTYPE (sv) == SVt_PVHV && SvSTASH (sv) != coro_state_stash) \ 755
791 { \ 756#define TRANSFER(ta) coro_state_transfer ((ta).prev, (ta).next, (ta).flags)
792 HE *he = hv_fetch_ent ((HV *)sv, ucoro_state_sv, 0, ucoro_state_hash); \
793 \
794 if (!he) \
795 croak ("%s() -- %s is a hashref but lacks the " UCORO_STATE " key", func, # sv); \
796 \
797 (sv) = SvRV (HeVAL(he)); \
798 } \
799 \
800 /* must also be changed inside Coro::Cont::yield */ \
801 if (!SvOBJECT (sv) || SvSTASH (sv) != coro_state_stash) \
802 croak ("%s() -- %s is not (and contains not) a Coro::State object", func, # sv); \
803 \
804 } while(0)
805 757
806static void 758static void
807coro_state_destroy (struct coro *coro) 759coro_state_destroy (struct coro *coro)
808{ 760{
809 if (coro->refcnt--) 761 if (coro->refcnt--)
… …
821 LOAD ((&temp)); /* this will get rid of defsv etc.. */ 773 LOAD ((&temp)); /* this will get rid of defsv etc.. */
822 774
823 coro->mainstack = 0; 775 coro->mainstack = 0;
824 } 776 }
825 777
826 deallocate_stack (coro); 778 stack_free (coro->stack);
827 SvREFCNT_dec (coro->args); 779 SvREFCNT_dec (coro->args);
828 Safefree (coro); 780 Safefree (coro);
829} 781}
830 782
831static int 783static int
… …
852static MGVTBL coro_state_vtbl = { 0, 0, 0, 0, coro_state_clear, 0, coro_state_dup, 0 }; 804static MGVTBL coro_state_vtbl = { 0, 0, 0, 0, coro_state_clear, 0, coro_state_dup, 0 };
853 805
854static struct coro * 806static struct coro *
855SvSTATE (SV *coro) 807SvSTATE (SV *coro)
856{ 808{
857 MAGIC *mg = SvMAGIC (SvROK (coro) ? SvRV (coro) : coro); 809 HV *stash;
810 MAGIC *mg;
811
812 if (SvROK (coro))
813 coro = SvRV (coro);
814
815 stash = SvSTASH (coro);
816 if (stash != coro_stash && stash != coro_state_stash)
817 {
818 /* very slow, but rare, check */
819 if (!sv_derived_from (sv_2mortal (newRV_inc (coro)), "Coro::State"))
820 croak ("Coro::State object required");
821 }
822
823 mg = SvMAGIC (coro);
858 assert (mg->mg_type == PERL_MAGIC_ext); 824 assert (mg->mg_type == PERL_MAGIC_ext);
859 return (struct coro *)mg->mg_ptr; 825 return (struct coro *)mg->mg_ptr;
860} 826}
861 827
862static void 828static void
829prepare_transfer (pTHX_ struct transfer_args *ta, SV *prev, SV *next, int flags)
830{
831 ta->prev = SvSTATE (prev);
832 ta->next = SvSTATE (next);
833 ta->flags = flags;
834}
835
836static void
863api_transfer (pTHX_ SV *prev, SV *next, int flags) 837api_transfer (SV *prev, SV *next, int flags)
864{ 838{
865 SV_CORO (prev, "Coro::transfer"); 839 dTHX;
866 SV_CORO (next, "Coro::transfer"); 840 struct transfer_args ta;
867 841
868 coro_state_transfer (aTHX_ SvSTATE (prev), SvSTATE (next), flags); 842 prepare_transfer (aTHX_ &ta, prev, next, flags);
843 TRANSFER (ta);
869} 844}
870 845
871/** Coro ********************************************************************/ 846/** Coro ********************************************************************/
872 847
873#define PRIO_MAX 3 848#define PRIO_MAX 3
… …
888 int prio; 863 int prio;
889 864
890 if (SvTYPE (sv) != SVt_PVHV) 865 if (SvTYPE (sv) != SVt_PVHV)
891 croak ("Coro::ready tried to enqueue something that is not a coroutine"); 866 croak ("Coro::ready tried to enqueue something that is not a coroutine");
892 867
893 {
894 SV *coro = sv;
895 SV_CORO (coro, "omg");
896 prio = SvSTATE (coro)->prio; 868 prio = SvSTATE (sv)->prio;
897 }
898 869
899 av_push (coro_ready [prio - PRIO_MIN], sv); 870 av_push (coro_ready [prio - PRIO_MIN], sv);
900 coro_nready++; 871 coro_nready++;
901} 872}
902 873
… …
931 coro_enq (aTHX_ SvREFCNT_inc (coro)); 902 coro_enq (aTHX_ SvREFCNT_inc (coro));
932 UNLOCK; 903 UNLOCK;
933} 904}
934 905
935static void 906static void
936api_schedule (void) 907prepare_schedule (aTHX_ struct transfer_args *ta)
937{ 908{
938 dTHX;
939
940 SV *prev, *next; 909 SV *current, *prev, *next;
941 910
942 LOCK; 911 LOCK;
943 912
944 prev = SvRV (GvSV (coro_current)); 913 current = GvSV (coro_current);
914
915 for (;;)
916 {
917 LOCK;
918
945 next = coro_deq (aTHX_ PRIO_MIN); 919 next = coro_deq (aTHX_ PRIO_MIN);
946 920
947 if (!next) 921 if (next)
948 next = SvREFCNT_inc (SvRV (GvSV (coro_idle))); 922 break;
923
924 UNLOCK;
925
926 {
927 dSP;
928
929 ENTER;
930 SAVETMPS;
931
932 PUSHMARK (SP);
933 PUTBACK;
934 call_sv (GvSV (coro_idle), G_DISCARD);
935
936 FREETMPS;
937 LEAVE;
938 }
939 }
940
941 prev = SvRV (current);
942 SvRV (current) = next;
949 943
950 /* free this only after the transfer */ 944 /* free this only after the transfer */
945 free_coro_mortal ();
951 coro_mortal = prev; 946 coro_mortal = prev;
952 SV_CORO (prev, "Coro::schedule");
953 947
954 SvRV (GvSV (coro_current)) = next; 948 ta->prev = SvSTATE (prev);
955 949 ta->next = SvSTATE (next);
956 SV_CORO (next, "Coro::schedule"); 950 ta->flags = TRANSFER_SAVE_ALL;
957 951
958 UNLOCK; 952 UNLOCK;
959
960 coro_state_transfer (aTHX_ SvSTATE (prev), SvSTATE (next),
961 TRANSFER_SAVE_ALL | TRANSFER_LAZY_STACK);
962} 953}
963 954
964static void 955static void
965api_cede (void) 956prepare_cede (aTHX_ struct transfer_args *ta)
966{ 957{
967 dTHX;
968
969 LOCK; 958 LOCK;
970 coro_enq (aTHX_ SvREFCNT_inc (SvRV (GvSV (coro_current)))); 959 coro_enq (aTHX_ SvREFCNT_inc (SvRV (GvSV (coro_current))));
971 UNLOCK; 960 UNLOCK;
972 961
962 prepare_schedule (ta);
963}
964
965static void
973 api_schedule (); 966api_schedule (void)
967{
968 dTHX;
969 struct transfer_args ta;
970
971 prepare_schedule (&ta);
972 TRANSFER (ta);
973}
974
975static void
976api_cede (void)
977{
978 dTHX;
979 struct transfer_args ta;
980
981 prepare_cede (&ta);
982 TRANSFER (ta);
974} 983}
975 984
976MODULE = Coro::State PACKAGE = Coro::State 985MODULE = Coro::State PACKAGE = Coro::State
977 986
978PROTOTYPES: DISABLE 987PROTOTYPES: DISABLE
979 988
980BOOT: 989BOOT:
981{ /* {} necessary for stoopid perl-5.6.x */ 990{
982#ifdef USE_ITHREADS 991#ifdef USE_ITHREADS
983 MUTEX_INIT (&coro_mutex); 992 MUTEX_INIT (&coro_mutex);
984#endif 993#endif
985 BOOT_PAGESIZE; 994 BOOT_PAGESIZE;
986 995
987 ucoro_state_sv = newSVpv (UCORO_STATE, sizeof(UCORO_STATE) - 1);
988 PERL_HASH(ucoro_state_hash, UCORO_STATE, sizeof(UCORO_STATE) - 1);
989 coro_state_stash = gv_stashpv ("Coro::State", TRUE); 996 coro_state_stash = gv_stashpv ("Coro::State", TRUE);
990 997
991 newCONSTSUB (coro_state_stash, "SAVE_DEFAV", newSViv (TRANSFER_SAVE_DEFAV)); 998 newCONSTSUB (coro_state_stash, "SAVE_DEFAV", newSViv (TRANSFER_SAVE_DEFAV));
992 newCONSTSUB (coro_state_stash, "SAVE_DEFSV", newSViv (TRANSFER_SAVE_DEFSV)); 999 newCONSTSUB (coro_state_stash, "SAVE_DEFSV", newSViv (TRANSFER_SAVE_DEFSV));
993 newCONSTSUB (coro_state_stash, "SAVE_ERRSV", newSViv (TRANSFER_SAVE_ERRSV)); 1000 newCONSTSUB (coro_state_stash, "SAVE_ERRSV", newSViv (TRANSFER_SAVE_ERRSV));
994 newCONSTSUB (coro_state_stash, "SAVE_CCTXT", newSViv (TRANSFER_SAVE_CCTXT));
995 1001
996 main_mainstack = PL_mainstack; 1002 main_mainstack = PL_mainstack;
997 1003
998 coroapi.ver = CORO_API_VERSION; 1004 coroapi.ver = CORO_API_VERSION;
999 coroapi.transfer = api_transfer; 1005 coroapi.transfer = api_transfer;
1006
1007 Newz (0, main_stack, 1, coro_stack);
1008 main_stack->idle_sp = (void *)-1;
1000 1009
1001 assert (("PRIO_NORMAL must be 0", !PRIO_NORMAL)); 1010 assert (("PRIO_NORMAL must be 0", !PRIO_NORMAL));
1002} 1011}
1003 1012
1004SV * 1013SV *
… …
1010 int i; 1019 int i;
1011 1020
1012 Newz (0, coro, 1, struct coro); 1021 Newz (0, coro, 1, struct coro);
1013 coro->args = newAV (); 1022 coro->args = newAV ();
1014 1023
1015 for (i = 1; i < items; i++)
1016 av_push (coro->args, newSVsv (ST (i)));
1017
1018 /*coro->mainstack = 0; *//*actual work is done inside transfer */
1019 /*coro->stack = 0;*/
1020
1021 hv = newHV (); 1024 hv = newHV ();
1022 sv_magicext ((SV *)hv, 0, PERL_MAGIC_ext, &coro_state_vtbl, (char *)coro, 0)->mg_flags |= MGf_DUP; 1025 sv_magicext ((SV *)hv, 0, PERL_MAGIC_ext, &coro_state_vtbl, (char *)coro, 0)->mg_flags |= MGf_DUP;
1023 RETVAL = sv_bless (newRV_noinc ((SV *)hv), gv_stashpv (klass, 1)); 1026 RETVAL = sv_bless (newRV_noinc ((SV *)hv), gv_stashpv (klass, 1));
1027
1028 for (i = 1; i < items; i++)
1029 av_push (coro->args, newSVsv (ST (i)));
1030
1031 coro->stack = main_stack;
1032 /*coro->mainstack = 0; *//*actual work is done inside transfer */
1033 /*coro->stack = 0;*/
1024} 1034}
1025 OUTPUT: 1035 OUTPUT:
1026 RETVAL 1036 RETVAL
1027 1037
1028void 1038void
1029transfer(prev, next, flags) 1039transfer (...)
1030 SV *prev 1040 ALIAS:
1031 SV *next 1041 Coro::schedule = 1
1032 int flags 1042 Coro::cede = 2
1043 _set_stacklevel = 3
1033 CODE: 1044 CODE:
1034 PUTBACK;
1035 SV_CORO (next, "Coro::transfer");
1036 SV_CORO (prev, "Coro::transfer");
1037 coro_state_transfer (aTHX_ SvSTATE (prev), SvSTATE (next), flags);
1038 SPAGAIN;
1039
1040int
1041prio (Coro::State coro, int newprio = 0)
1042 ALIAS:
1043 nice = 1
1044 CODE:
1045{ 1045{
1046 RETVAL = coro->prio; 1046 struct transfer_args ta;
1047 1047
1048 if (items > 1) 1048 switch (ix)
1049 { 1049 {
1050 case 0:
1050 if (ix) 1051 if (items != 3)
1051 newprio += coro->prio; 1052 croak ("Coro::State::transfer(prev,next,flags) expects three arguments, not %d", items);
1052 1053
1053 if (newprio < PRIO_MIN) newprio = PRIO_MIN; 1054 prepare_transfer (&ta, ST (0), ST (1), SvIV (ST (2)));
1054 if (newprio > PRIO_MAX) newprio = PRIO_MAX; 1055 break;
1055 1056
1056 coro->prio = newprio; 1057 case 1:
1058 prepare_schedule (&ta);
1059 break;
1060
1061 case 2:
1062 prepare_cede (&ta);
1063 break;
1064
1065 case 3:
1066 ta.prev = (struct coro *)INT2PTR (coro_stack *, SvIV (ST (0)));
1067 ta.next = 0;
1068 ta.flags = TRANSFER_SET_STACKLEVEL;
1069 break;
1057 } 1070 }
1071
1072 TRANSFER (ta);
1058} 1073}
1059 1074
1060void 1075void
1061_clone_state_from (SV *dst, SV *src) 1076_clone_state_from (SV *dst, SV *src)
1062 CODE: 1077 CODE:
… …
1066 sv_unmagic (SvRV (dst), PERL_MAGIC_ext); 1081 sv_unmagic (SvRV (dst), PERL_MAGIC_ext);
1067 1082
1068 ++coro_src->refcnt; 1083 ++coro_src->refcnt;
1069 sv_magicext (SvRV (dst), 0, PERL_MAGIC_ext, &coro_state_vtbl, (char *)coro_src, 0)->mg_flags |= MGf_DUP; 1084 sv_magicext (SvRV (dst), 0, PERL_MAGIC_ext, &coro_state_vtbl, (char *)coro_src, 0)->mg_flags |= MGf_DUP;
1070} 1085}
1086
1087void
1088_nonlocal_goto (IV nextop)
1089 CODE:
1090 /* uuh, somebody will kill me again for this */
1091 PL_op->op_next = INT2PTR (OP *, nextop);
1071 1092
1072void 1093void
1073_exit (code) 1094_exit (code)
1074 int code 1095 int code
1075 PROTOTYPE: $ 1096 PROTOTYPE: $
… …
1080 1101
1081void 1102void
1082yield (...) 1103yield (...)
1083 PROTOTYPE: @ 1104 PROTOTYPE: @
1084 CODE: 1105 CODE:
1106{
1085 SV *yieldstack; 1107 SV *yieldstack;
1086 SV *sv; 1108 SV *sv;
1087 AV *defav = GvAV (PL_defgv); 1109 AV *defav = GvAV (PL_defgv);
1088 struct coro *prev, *next; 1110 struct coro *prev, *next;
1089 1111
… …
1098 av_fill (defav, items - 1); 1120 av_fill (defav, items - 1);
1099 while (items--) 1121 while (items--)
1100 av_store (defav, items, SvREFCNT_inc (ST(items))); 1122 av_store (defav, items, SvREFCNT_inc (ST(items)));
1101 1123
1102 sv = av_pop ((AV *)SvRV (yieldstack)); 1124 sv = av_pop ((AV *)SvRV (yieldstack));
1103 prev = SvSTATE ((SV*)SvRV (*av_fetch ((AV *)SvRV (sv), 0, 0))); 1125 prev = SvSTATE (*av_fetch ((AV *)SvRV (sv), 0, 0));
1104 next = SvSTATE ((SV*)SvRV (*av_fetch ((AV *)SvRV (sv), 1, 0))); 1126 next = SvSTATE (*av_fetch ((AV *)SvRV (sv), 1, 0));
1105 SvREFCNT_dec (sv); 1127 SvREFCNT_dec (sv);
1106 1128
1107 coro_state_transfer (aTHX_ prev, next, 0); 1129 coro_state_transfer (aTHX_ prev, next, 0);
1130}
1108 1131
1109MODULE = Coro::State PACKAGE = Coro 1132MODULE = Coro::State PACKAGE = Coro
1110 1133
1111BOOT: 1134BOOT:
1112{ 1135{
1113 int i; 1136 int i;
1137
1114 HV *stash = gv_stashpv ("Coro", TRUE); 1138 coro_stash = gv_stashpv ("Coro", TRUE);
1115 1139
1116 newCONSTSUB (stash, "PRIO_MAX", newSViv (PRIO_MAX)); 1140 newCONSTSUB (coro_stash, "PRIO_MAX", newSViv (PRIO_MAX));
1117 newCONSTSUB (stash, "PRIO_HIGH", newSViv (PRIO_HIGH)); 1141 newCONSTSUB (coro_stash, "PRIO_HIGH", newSViv (PRIO_HIGH));
1118 newCONSTSUB (stash, "PRIO_NORMAL", newSViv (PRIO_NORMAL)); 1142 newCONSTSUB (coro_stash, "PRIO_NORMAL", newSViv (PRIO_NORMAL));
1119 newCONSTSUB (stash, "PRIO_LOW", newSViv (PRIO_LOW)); 1143 newCONSTSUB (coro_stash, "PRIO_LOW", newSViv (PRIO_LOW));
1120 newCONSTSUB (stash, "PRIO_IDLE", newSViv (PRIO_IDLE)); 1144 newCONSTSUB (coro_stash, "PRIO_IDLE", newSViv (PRIO_IDLE));
1121 newCONSTSUB (stash, "PRIO_MIN", newSViv (PRIO_MIN)); 1145 newCONSTSUB (coro_stash, "PRIO_MIN", newSViv (PRIO_MIN));
1122 1146
1123 coro_current = gv_fetchpv ("Coro::current", TRUE, SVt_PV); 1147 coro_current = gv_fetchpv ("Coro::current", TRUE, SVt_PV);
1124 coro_idle = gv_fetchpv ("Coro::idle" , TRUE, SVt_PV); 1148 coro_idle = gv_fetchpv ("Coro::idle" , TRUE, SVt_PV);
1125 1149
1126 for (i = PRIO_MAX - PRIO_MIN + 1; i--; ) 1150 for (i = PRIO_MAX - PRIO_MIN + 1; i--; )
… …
1139 sv_setiv (sv, (IV)&coroapi); 1163 sv_setiv (sv, (IV)&coroapi);
1140 SvREADONLY_on (sv); 1164 SvREADONLY_on (sv);
1141 } 1165 }
1142} 1166}
1143 1167
1144#if !PERL_MICRO 1168int
1169prio (Coro::State coro, int newprio = 0)
1170 ALIAS:
1171 nice = 1
1172 CODE:
1173{
1174 RETVAL = coro->prio;
1175
1176 if (items > 1)
1177 {
1178 if (ix)
1179 newprio += coro->prio;
1180
1181 if (newprio < PRIO_MIN) newprio = PRIO_MIN;
1182 if (newprio > PRIO_MAX) newprio = PRIO_MAX;
1183
1184 coro->prio = newprio;
1185 }
1186}
1145 1187
1146void 1188void
1147ready (self) 1189ready (SV *self)
1148 SV * self
1149 PROTOTYPE: $ 1190 PROTOTYPE: $
1150 CODE: 1191 CODE:
1151 api_ready (self); 1192 api_ready (self);
1152
1153#endif
1154 1193
1155int 1194int
1156nready (...) 1195nready (...)
1157 PROTOTYPE: 1196 PROTOTYPE:
1158 CODE: 1197 CODE:
1159 RETVAL = coro_nready; 1198 RETVAL = coro_nready;
1160 OUTPUT: 1199 OUTPUT:
1161 RETVAL 1200 RETVAL
1162 1201
1163void 1202MODULE = Coro::State PACKAGE = Coro::AIO
1164schedule (...)
1165 PROTOTYPE:
1166 CODE:
1167 api_schedule ();
1168 1203
1169void
1170cede (...)
1171 PROTOTYPE:
1172 CODE:
1173 api_cede ();
1174
1175# and these are hacks
1176SV * 1204SV *
1177_aio_get_state () 1205_get_state ()
1178 CODE: 1206 CODE:
1179{ 1207{
1180 struct { 1208 struct {
1181 int errorno; 1209 int errorno;
1182 int laststype; 1210 int laststype;
… …
1193} 1221}
1194 OUTPUT: 1222 OUTPUT:
1195 RETVAL 1223 RETVAL
1196 1224
1197void 1225void
1198_aio_set_state (char *data_) 1226_set_state (char *data_)
1199 PROTOTYPE: $ 1227 PROTOTYPE: $
1200 CODE: 1228 CODE:
1201{ 1229{
1202 struct { 1230 struct {
1203 int errorno; 1231 int errorno;

Diff Legend

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