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.79 by root, Thu Nov 2 12:29:08 2006 UTC vs.
Revision 1.89 by root, Sat Nov 25 00:40:26 2006 UTC

57# else 57# else
58# define BOOT_PAGESIZE 58# define BOOT_PAGESIZE
59# endif 59# endif
60#endif 60#endif
61 61
62#define SUB_INIT "Coro::State::initialize" 62#define SUB_INIT "Coro::State::initialize"
63#define UCORO_STATE "_coro_state"
64 63
65/* The next macro should declare a variable stacklevel that contains and approximation 64/* 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 65 * to the current C stack pointer. Its property is that it changes with each call
67 * and should be unique. */ 66 * and should be unique. */
68#define dSTACKLEVEL void *stacklevel = &stacklevel 67#define dSTACKLEVEL void *stacklevel = &stacklevel
82# define UNLOCK (void)0 81# define UNLOCK (void)0
83#endif 82#endif
84 83
85static struct CoroAPI coroapi; 84static struct CoroAPI coroapi;
86static AV *main_mainstack; /* used to differentiate between $main and others */ 85static AV *main_mainstack; /* used to differentiate between $main and others */
87static HV *coro_state_stash; 86static 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 */ 87static SV *coro_mortal; /* will be freed after next transfer */
91 88
92/* this is actually not only the c stack but also c registers etc... */ 89/* this is actually not just the c stack but also c registers etc... */
93typedef struct { 90typedef struct coro_stack {
94 int refcnt; /* pointer reference counter */ 91 struct coro_stack *next;
95 int usecnt; /* shared by how many coroutines */
96 int gencnt; /* generation counter */
97 92
98 coro_context cctx; 93 void *idle_sp;
99
100 void *sptr; 94 void *sptr;
101 long ssize; /* positive == mmap, otherwise malloc */ 95 long ssize; /* positive == mmap, otherwise malloc */
96
97 /* cpu state */
98 coro_context cctx;
102} coro_stack; 99} coro_stack;
103 100
101static coro_stack *main_stack;
102
104struct coro { 103struct coro {
105 /* the top-level JMPENV for each coroutine, needed to catch dies. */
106 JMPENV start_env;
107
108 /* the optional C context */
109 coro_stack *stack;
110 void *cursp;
111 int gencnt;
112
113 /* optionally saved, might be zero */ 104 /* optionally saved, might be zero */
114 AV *defav; 105 AV *defav;
115 SV *defsv; 106 SV *defsv;
116 SV *errsv; 107 SV *errsv;
117 108
118 /* saved global state not related to stacks */ 109 /* saved global state not related to stacks */
119 U8 dowarn; 110 U8 dowarn;
120 I32 in_eval; 111 I32 in_eval;
112
113 /* the c stack, if any */
114 coro_stack *stack;
121 115
122 /* the stacks and related info (callchain etc..) */ 116 /* the stacks and related info (callchain etc..) */
123 PERL_SI *curstackinfo; 117 PERL_SI *curstackinfo;
124 AV *curstack; 118 AV *curstack;
125 AV *mainstack; 119 AV *mainstack;
148 I32 retstack_max; 142 I32 retstack_max;
149 PMOP *curpm; 143 PMOP *curpm;
150 COP *curcop; 144 COP *curcop;
151 JMPENV *top_env; 145 JMPENV *top_env;
152 146
147 /* coro process data */
148 int prio;
149
153 /* data associated with this coroutine (initial args) */ 150 /* data associated with this coroutine (initial args) */
154 AV *args; 151 AV *args;
152 int refcnt;
155}; 153};
156 154
157typedef struct coro *Coro__State; 155typedef struct coro *Coro__State;
158typedef struct coro *Coro__State_or_hashref; 156typedef struct coro *Coro__State_or_hashref;
159 157
534 Safefree (PL_retstack); 532 Safefree (PL_retstack);
535#endif 533#endif
536} 534}
537 535
538static void 536static void
539allocate_stack (Coro__State ctx, int alloc) 537setup_coro (struct coro *coro)
540{
541 coro_stack *stack;
542
543 New (0, stack, 1, coro_stack);
544
545 stack->refcnt = 1;
546 stack->usecnt = 1;
547 stack->gencnt = ctx->gencnt = 0;
548
549 if (alloc)
550 {
551#if HAVE_MMAP
552 stack->ssize = ((STACKSIZE * sizeof (long) + PAGESIZE - 1) / PAGESIZE + STACKGUARD) * PAGESIZE; /* mmap should do allocate-on-write for us */
553 stack->sptr = mmap (0, stack->ssize, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_PRIVATE|MAP_ANONYMOUS, 0, 0);
554 if (stack->sptr != (void *)-1)
555 {
556# if STACKGUARD
557 mprotect (stack->sptr, STACKGUARD * PAGESIZE, PROT_NONE);
558# endif
559 }
560 else
561#endif
562 {
563 stack->ssize = - (STACKSIZE * (long)sizeof (long));
564 New (0, stack->sptr, STACKSIZE, long);
565 }
566 }
567 else
568 stack->sptr = 0;
569
570 ctx->stack = stack;
571}
572
573static void
574deallocate_stack (Coro__State ctx)
575{
576 coro_stack *stack = ctx->stack;
577
578 ctx->stack = 0;
579
580 if (stack)
581 {
582 if (!--stack->refcnt)
583 {
584#ifdef HAVE_MMAP
585 if (stack->ssize > 0 && stack->sptr)
586 munmap (stack->sptr, stack->ssize);
587 else
588#endif
589 Safefree (stack->sptr);
590
591 Safefree (stack);
592 }
593 else if (ctx->gencnt == stack->gencnt)
594 --stack->usecnt;
595 }
596}
597
598static void
599setup_coro (void *arg)
600{ 538{
601 /* 539 /*
602 * emulate part of the perl startup here. 540 * emulate part of the perl startup here.
603 */ 541 */
604 dTHX; 542 dTHX;
605 dSP; 543 dSP;
606 Coro__State ctx = (Coro__State)arg; 544 UNOP myop;
607 SV *sub_init = (SV *)get_cv (SUB_INIT, FALSE); 545 SV *sub_init = (SV *)get_cv (SUB_INIT, FALSE);
608 546
609 coro_init_stacks (aTHX); 547 coro_init_stacks (aTHX);
610 /*PL_curcop = 0;*/ 548 /*PL_curcop = 0;*/
611 /*PL_in_eval = PL_in_eval;*/ /* inherit */ 549 /*PL_in_eval = PL_in_eval;*/ /* inherit */
612 SvREFCNT_dec (GvAV (PL_defgv)); 550 SvREFCNT_dec (GvAV (PL_defgv));
613 GvAV (PL_defgv) = ctx->args; ctx->args = 0; 551 GvAV (PL_defgv) = coro->args; coro->args = 0;
614 552
615 SPAGAIN; 553 SPAGAIN;
616 554
617 if (ctx->stack) 555 Zero (&myop, 1, UNOP);
618 { 556 myop.op_next = Nullop;
619 ctx->cursp = 0; 557 myop.op_flags = OPf_WANT_VOID;
620 558
559 PL_op = (OP *)&myop;
560
621 PUSHMARK(SP); 561 PUSHMARK(SP);
562 XPUSHs (sub_init);
622 PUTBACK; 563 PUTBACK;
623 (void) call_sv (sub_init, G_VOID|G_NOARGS|G_EVAL); 564 PL_op = PL_ppaddr[OP_ENTERSUB](aTHX);
565 SPAGAIN;
624 566
625 if (SvTRUE (ERRSV)) 567 ENTER; /* necessary e.g. for dounwind */
626 croak (NULL); 568}
627 else 569
628 croak ("FATAL: CCTXT coroutine returned!"); 570static void
571transfer_tail ()
572{
573 if (coro_mortal)
574 {
575 SvREFCNT_dec (coro_mortal);
576 coro_mortal = 0;
629 } 577 }
630 else
631 {
632 UNOP myop;
633 578
634 PL_op = (OP *)&myop; 579 UNLOCK;
635
636 Zero(&myop, 1, UNOP);
637 myop.op_next = Nullop;
638 myop.op_flags = OPf_WANT_VOID;
639
640 PUSHMARK(SP);
641 XPUSHs (sub_init);
642 /*
643 * the next line is slightly wrong, as PL_op->op_next
644 * is actually being executed so we skip the first op.
645 * that doesn't matter, though, since it is only
646 * pp_nextstate and we never return...
647 * ah yes, and I don't care anyways ;)
648 */
649 PUTBACK;
650 PL_op = PL_ppaddr[OP_ENTERSUB](aTHX);
651 SPAGAIN;
652
653 ENTER; /* necessary e.g. for dounwind */
654 }
655} 580}
656 581
657static void 582static void
658continue_coro (void *arg) 583coro_run (void *arg)
659{ 584{
660 /* 585 /*
661 * this is a _very_ stripped down perl interpreter ;) 586 * this is a _very_ stripped down perl interpreter ;)
662 */ 587 */
663 dTHX; 588 dTHX;
664 Coro__State ctx = (Coro__State)arg;
665 589
590 transfer_tail ();
591
666 PL_top_env = &ctx->start_env; 592 PL_top_env = &PL_start_env;
667
668 ctx->cursp = 0;
669 PL_op = PL_op->op_next; 593 PL_restartop = PL_op->op_next;
670 CALLRUNOPS(aTHX); 594 /* somebody will hit me for both perl_run and PL_restart_top */
595 perl_run (aTHX_ PERL_GET_CONTEXT);
671 596
672 abort (); 597 abort ();
673} 598}
674 599
600static coro_stack *
601stack_new ()
602{
603 coro_stack *stack;
604
605 New (0, stack, 1, coro_stack);
606
607#if HAVE_MMAP
608
609 stack->ssize = ((STACKSIZE * sizeof (long) + PAGESIZE - 1) / PAGESIZE + STACKGUARD) * PAGESIZE; /* mmap should do allocate-on-write for us */
610 stack->sptr = mmap (0, stack->ssize, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_PRIVATE|MAP_ANONYMOUS, 0, 0);
611
612 if (stack->sptr == (void *)-1)
613 {
614 fprintf (stderr, "FATAL: unable to mmap stack for coroutine\n");
615 _exit (EXIT_FAILURE);
616 }
617
618 mprotect (stack->sptr, STACKGUARD * PAGESIZE, PROT_NONE);
619
620#else
621
622 stack->ssize = STACKSIZE * (long)sizeof (long);
623 New (0, stack->sptr, STACKSIZE, long);
624
625 if (!stack->sptr)
626 {
627 fprintf (stderr, "FATAL: unable to malloc stack for coroutine\n");
628 _exit (EXIT_FAILURE);
629 }
630
631#endif
632
633 coro_create (&stack->cctx, coro_run, 0, stack->sptr, stack->ssize);
634
635 return stack;
636}
637
675static void 638static void
639stack_free (coro_stack *stack)
640{
641 if (!stack || stack == main_stack)
642 return;
643
644#if HAVE_MMAP
645 munmap (stack->sptr, stack->ssize);
646#else
647 Safefree (stack->sptr);
648#endif
649
650 Safefree (stack);
651}
652
653static coro_stack *stack_first;
654
655static void
656stack_get (struct coro *coro)
657{
658 if (stack_first)
659 {
660 coro->stack = stack_first;
661 stack_first = stack_first->next;
662 }
663 else
664 coro->stack = stack_new ();
665}
666
667static void
668stack_put (coro_stack *stack)
669{
670 stack->next = stack_first;
671 stack_first = stack;
672}
673
674/* never call directly, always through the coro_state_transfer global variable */
675static void
676transfer (pTHX_ struct coro *prev, struct coro *next, int flags) 676transfer_impl (pTHX_ struct coro *prev, struct coro *next, int flags)
677{ 677{
678 dSTACKLEVEL; 678 dSTACKLEVEL;
679 679
680 /* sometimes transfer is only called to set idle_sp */
681 if (!prev->stack->idle_sp)
682 prev->stack->idle_sp = stacklevel;
683
684 LOCK;
685
680 if (prev != next) 686 if (prev != next)
681 { 687 {
682 if (next->mainstack) 688 coro_stack *prev_stack = prev->stack;
689
690 /* possibly "free" the stack */
691 if (prev_stack->idle_sp == stacklevel)
683 { 692 {
684 LOCK; 693 stack_put (prev_stack);
694 prev->stack = 0;
695 }
696
697 if (!next->mainstack)
698 {
699 /* first get rid of the old state */
700 SAVE (prev, -1);
701 /* setup coroutine call */
702 setup_coro (next);
703 next->stack = 0;
704 }
705 else
706 {
685 SAVE (prev, flags); 707 SAVE (prev, flags);
686 LOAD (next); 708 LOAD (next);
687 UNLOCK;
688
689 /* mark this state as in-use */
690 next->mainstack = 0;
691 next->tmps_ix = -2;
692
693 /* stacklevel changed? if yes, grab the stack for us! */
694 if (flags & TRANSFER_SAVE_CCTXT)
695 {
696 if (!prev->stack)
697 allocate_stack (prev, 0);
698 else if (prev->cursp != stacklevel
699 && prev->stack->usecnt > 1)
700 {
701 prev->gencnt = ++prev->stack->gencnt;
702 prev->stack->usecnt = 1;
703 }
704
705 /* has our stack been invalidated? */
706 if (next->stack && next->stack->gencnt != next->gencnt)
707 {
708 deallocate_stack (next);
709 allocate_stack (next, 1);
710 coro_create (&(next->stack->cctx),
711 continue_coro, (void *)next,
712 next->stack->sptr, labs (next->stack->ssize));
713 }
714
715 coro_transfer (&(prev->stack->cctx), &(next->stack->cctx));
716 prev->cursp = stacklevel;
717 /* don't add any code here */
718 }
719 else
720 next->cursp = stacklevel;
721 } 709 }
722 else if (next->tmps_ix == -2)
723 croak ("tried to transfer to running coroutine");
724 else
725 {
726 LOCK;
727 SAVE (prev, -1); /* first get rid of the old state */
728 UNLOCK;
729 710
730 if (flags & TRANSFER_SAVE_CCTXT) 711 if (!next->stack)
731 { 712 stack_get (next);
732 if (!prev->stack)
733 allocate_stack (prev, 0);
734 713
735 if (prev->stack->sptr && flags & TRANSFER_LAZY_STACK) 714 if (prev_stack != next->stack)
736 {
737 PL_top_env = &next->start_env;
738
739 setup_coro (next);
740 next->cursp = stacklevel;
741
742 prev->stack->refcnt++;
743 prev->stack->usecnt++;
744 next->stack = prev->stack;
745 next->gencnt = prev->gencnt;
746 }
747 else
748 {
749 assert (!next->stack);
750 allocate_stack (next, 1);
751 coro_create (&(next->stack->cctx),
752 setup_coro, (void *)next,
753 next->stack->sptr, labs (next->stack->ssize));
754 coro_transfer (&(prev->stack->cctx), &(next->stack->cctx)); 715 coro_transfer (&prev_stack->cctx, &next->stack->cctx);
755 prev->cursp = stacklevel;
756 /* don't add any code here */
757 }
758 }
759 else
760 {
761 setup_coro (next);
762 next->cursp = stacklevel;
763 }
764 }
765 } 716 }
766 717
767 LOCK; 718 transfer_tail ();
768 if (coro_mortal) 719}
720
721/* use this function pointer to call the above function */
722/* this is done to increase chances of the compiler not inlining the call */
723void (*coro_state_transfer)(pTHX_ struct coro *prev, struct coro *next, int flags) = transfer_impl;
724
725static void
726coro_state_destroy (struct coro *coro)
727{
728 if (coro->refcnt--)
729 return;
730
731 if (coro->mainstack && coro->mainstack != main_mainstack)
769 { 732 {
770 SvREFCNT_dec (coro_mortal); 733 struct coro temp;
734
735 SAVE (aTHX_ (&temp), TRANSFER_SAVE_ALL);
736 LOAD (aTHX_ coro);
737
738 destroy_stacks (aTHX);
739
740 LOAD ((&temp)); /* this will get rid of defsv etc.. */
741
771 coro_mortal = 0; 742 coro->mainstack = 0;
772 } 743 }
773 UNLOCK;
774}
775 744
776#define SV_CORO(sv,func) \ 745 stack_free (coro->stack);
777 do { \ 746 SvREFCNT_dec (coro->args);
778 if (SvROK (sv)) \ 747 Safefree (coro);
779 sv = SvRV (sv); \ 748}
780 \
781 if (SvTYPE (sv) == SVt_PVHV) \
782 { \
783 HE *he = hv_fetch_ent ((HV *)sv, ucoro_state_sv, 0, ucoro_state_hash); \
784 \
785 if (!he) \
786 croak ("%s() -- %s is a hashref but lacks the " UCORO_STATE " key", func, # sv); \
787 \
788 (sv) = SvRV (HeVAL(he)); \
789 } \
790 \
791 /* must also be changed inside Coro::Cont::yield */ \
792 if (!SvOBJECT (sv) || SvSTASH (sv) != coro_state_stash) \
793 croak ("%s() -- %s is not (and contains not) a Coro::State object", func, # sv); \
794 \
795 } while(0)
796 749
797#define SvSTATE(sv) INT2PTR (struct coro *, SvIV (sv))
798
799static void 750static int
751coro_state_clear (SV *sv, MAGIC *mg)
752{
753 struct coro *coro = (struct coro *)mg->mg_ptr;
754 mg->mg_ptr = 0;
755
756 coro_state_destroy (coro);
757
758 return 0;
759}
760
761static int
762coro_state_dup (MAGIC *mg, CLONE_PARAMS *params)
763{
764 struct coro *coro = (struct coro *)mg->mg_ptr;
765
766 ++coro->refcnt;
767
768 return 0;
769}
770
771static MGVTBL coro_state_vtbl = { 0, 0, 0, 0, coro_state_clear, 0, coro_state_dup, 0 };
772
773static struct coro *
774SvSTATE (SV *coro)
775{
776 HV *stash;
777 MAGIC *mg;
778
779 if (SvROK (coro))
780 coro = SvRV (coro);
781
782 stash = SvSTASH (coro);
783 if (stash != coro_stash && stash != coro_state_stash)
784 {
785 /* very slow, but rare, check */
786 if (!sv_derived_from (sv_2mortal (newRV_inc (coro)), "Coro::State"))
787 croak ("Coro::State object required");
788 }
789
790 mg = SvMAGIC (coro);
791 assert (mg->mg_type == PERL_MAGIC_ext);
792 return (struct coro *)mg->mg_ptr;
793}
794
795static void
800api_transfer(pTHX_ SV *prev, SV *next, int flags) 796api_transfer (pTHX_ SV *prev, SV *next, int flags)
801{ 797{
802 SV_CORO (prev, "Coro::transfer");
803 SV_CORO (next, "Coro::transfer");
804
805 transfer (aTHX_ SvSTATE (prev), SvSTATE (next), flags); 798 coro_state_transfer (aTHX_ SvSTATE (prev), SvSTATE (next), flags);
806} 799}
807 800
808/** Coro ********************************************************************/ 801/** Coro ********************************************************************/
809 802
810#define PRIO_MAX 3 803#define PRIO_MAX 3
814#define PRIO_IDLE -3 807#define PRIO_IDLE -3
815#define PRIO_MIN -4 808#define PRIO_MIN -4
816 809
817/* for Coro.pm */ 810/* for Coro.pm */
818static GV *coro_current, *coro_idle; 811static GV *coro_current, *coro_idle;
819static AV *coro_ready[PRIO_MAX-PRIO_MIN+1]; 812static AV *coro_ready [PRIO_MAX-PRIO_MIN+1];
820static int coro_nready; 813static int coro_nready;
821 814
822static void 815static void
823coro_enq (pTHX_ SV *sv) 816coro_enq (pTHX_ SV *sv)
824{ 817{
825 SV **xprio;
826 int prio; 818 int prio;
827 819
828 if (SvTYPE (sv) != SVt_PVHV) 820 if (SvTYPE (sv) != SVt_PVHV)
829 croak ("Coro::ready tried to enqueue something that is not a coroutine"); 821 croak ("Coro::ready tried to enqueue something that is not a coroutine");
830 822
831 xprio = hv_fetch ((HV *)sv, "prio", 4, 0); 823 prio = SvSTATE (sv)->prio;
832 prio = xprio ? SvIV (*xprio) : PRIO_NORMAL;
833
834 prio = prio > PRIO_MAX ? PRIO_MAX
835 : prio < PRIO_MIN ? PRIO_MIN
836 : prio;
837 824
838 av_push (coro_ready [prio - PRIO_MIN], sv); 825 av_push (coro_ready [prio - PRIO_MIN], sv);
839 coro_nready++; 826 coro_nready++;
840} 827}
841 828
847 min_prio -= PRIO_MIN; 834 min_prio -= PRIO_MIN;
848 if (min_prio < 0) 835 if (min_prio < 0)
849 min_prio = 0; 836 min_prio = 0;
850 837
851 for (prio = PRIO_MAX - PRIO_MIN + 1; --prio >= min_prio; ) 838 for (prio = PRIO_MAX - PRIO_MIN + 1; --prio >= min_prio; )
852 if (av_len (coro_ready[prio]) >= 0) 839 if (AvFILLp (coro_ready [prio]) >= 0)
853 { 840 {
854 coro_nready--; 841 coro_nready--;
855 return av_shift (coro_ready[prio]); 842 return av_shift (coro_ready [prio]);
856 } 843 }
857 844
858 return 0; 845 return 0;
859} 846}
860 847
875api_schedule (void) 862api_schedule (void)
876{ 863{
877 dTHX; 864 dTHX;
878 865
879 SV *prev, *next; 866 SV *prev, *next;
867 SV *current = GvSV (coro_current);
880 868
869 for (;;)
870 {
881 LOCK; 871 LOCK;
882 872
883 prev = SvRV (GvSV (coro_current));
884 next = coro_deq (aTHX_ PRIO_MIN); 873 next = coro_deq (aTHX_ PRIO_MIN);
885 874
886 if (!next) 875 if (next)
887 next = SvREFCNT_inc (SvRV (GvSV (coro_idle))); 876 break;
877
878 UNLOCK;
879
880 {
881 dSP;
882
883 ENTER;
884 SAVETMPS;
885
886 PUSHMARK (SP);
887 PUTBACK;
888 call_sv (GvSV (coro_idle), G_DISCARD);
889
890 FREETMPS;
891 LEAVE;
892 }
893 }
894
895 prev = SvRV (current);
896 SvRV (current) = next;
888 897
889 /* free this only after the transfer */ 898 /* free this only after the transfer */
890 coro_mortal = prev; 899 coro_mortal = prev;
891 SV_CORO (prev, "Coro::schedule");
892
893 SvRV (GvSV (coro_current)) = next;
894
895 SV_CORO (next, "Coro::schedule");
896 900
897 UNLOCK; 901 UNLOCK;
898 902
899 transfer (aTHX_ SvSTATE (prev), SvSTATE (next), 903 coro_state_transfer (aTHX_ SvSTATE (prev), SvSTATE (next), TRANSFER_SAVE_ALL);
900 TRANSFER_SAVE_ALL | TRANSFER_LAZY_STACK);
901} 904}
905
906static int coro_cede_self;
902 907
903static void 908static void
904api_cede (void) 909api_cede (void)
905{ 910{
906 dTHX; 911 dTHX;
912 SV *current = SvREFCNT_inc (SvRV (GvSV (coro_current)));
907 913
908 LOCK; 914 LOCK;
909 coro_enq (aTHX_ SvREFCNT_inc (SvRV (GvSV (coro_current)))); 915
916 if (coro_cede_self)
917 {
918 AV *runqueue = coro_ready [PRIO_MAX - PRIO_MIN];
919 av_unshift (runqueue, 1);
920 av_store (runqueue, 0, current);
921 coro_nready++;
922 coro_cede_self = 0;
923 }
924 else
925 coro_enq (aTHX_ current);
926
910 UNLOCK; 927 UNLOCK;
911 928
912 api_schedule (); 929 api_schedule ();
913} 930}
914 931
915MODULE = Coro::State PACKAGE = Coro::State 932MODULE = Coro::State PACKAGE = Coro::State
916 933
917PROTOTYPES: ENABLE 934PROTOTYPES: DISABLE
918 935
919BOOT: 936BOOT:
920{ /* {} necessary for stoopid perl-5.6.x */ 937{
921#ifdef USE_ITHREADS 938#ifdef USE_ITHREADS
922 MUTEX_INIT (&coro_mutex); 939 MUTEX_INIT (&coro_mutex);
923#endif 940#endif
924 BOOT_PAGESIZE; 941 BOOT_PAGESIZE;
925 942
926 ucoro_state_sv = newSVpv (UCORO_STATE, sizeof(UCORO_STATE) - 1);
927 PERL_HASH(ucoro_state_hash, UCORO_STATE, sizeof(UCORO_STATE) - 1);
928 coro_state_stash = gv_stashpv ("Coro::State", TRUE); 943 coro_state_stash = gv_stashpv ("Coro::State", TRUE);
929 944
930 newCONSTSUB (coro_state_stash, "SAVE_DEFAV", newSViv (TRANSFER_SAVE_DEFAV)); 945 newCONSTSUB (coro_state_stash, "SAVE_DEFAV", newSViv (TRANSFER_SAVE_DEFAV));
931 newCONSTSUB (coro_state_stash, "SAVE_DEFSV", newSViv (TRANSFER_SAVE_DEFSV)); 946 newCONSTSUB (coro_state_stash, "SAVE_DEFSV", newSViv (TRANSFER_SAVE_DEFSV));
932 newCONSTSUB (coro_state_stash, "SAVE_ERRSV", newSViv (TRANSFER_SAVE_ERRSV)); 947 newCONSTSUB (coro_state_stash, "SAVE_ERRSV", newSViv (TRANSFER_SAVE_ERRSV));
933 newCONSTSUB (coro_state_stash, "SAVE_CCTXT", newSViv (TRANSFER_SAVE_CCTXT));
934 948
935 main_mainstack = PL_mainstack; 949 main_mainstack = PL_mainstack;
936 950
937 coroapi.ver = CORO_API_VERSION; 951 coroapi.ver = CORO_API_VERSION;
938 coroapi.transfer = api_transfer; 952 coroapi.transfer = api_transfer;
939}
940 953
941Coro::State 954 Newz (0, main_stack, 1, coro_stack);
942_newprocess(args) 955 main_stack->idle_sp = (void *)-1;
943 SV * args 956
944 PROTOTYPE: $ 957 assert (("PRIO_NORMAL must be 0", !PRIO_NORMAL));
958}
959
960SV *
961new (char *klass, ...)
945 CODE: 962 CODE:
946 Coro__State coro; 963{
964 struct coro *coro;
965 HV *hv;
966 int i;
947 967
948 if (!SvROK (args) || SvTYPE (SvRV (args)) != SVt_PVAV)
949 croak ("Coro::State::_newprocess expects an arrayref");
950
951 Newz (0, coro, 1, struct coro); 968 Newz (0, coro, 1, struct coro);
969 coro->args = newAV ();
952 970
953 coro->args = (AV *)SvREFCNT_inc (SvRV (args)); 971 hv = newHV ();
972 sv_magicext ((SV *)hv, 0, PERL_MAGIC_ext, &coro_state_vtbl, (char *)coro, 0)->mg_flags |= MGf_DUP;
973 RETVAL = sv_bless (newRV_noinc ((SV *)hv), gv_stashpv (klass, 1));
974
975 av_push (coro->args, newSVsv (RETVAL));
976 for (i = 1; i < items; i++)
977 av_push (coro->args, newSVsv (ST (i)));
978
979 coro->stack = main_stack;
954 /*coro->mainstack = 0; *//*actual work is done inside transfer */ 980 /*coro->mainstack = 0; *//*actual work is done inside transfer */
955 /*coro->stack = 0;*/ 981 /*coro->stack = 0;*/
956 982}
957 /* same as JMPENV_BOOTSTRAP */
958 /* we might be able to recycle start_env, but safe is safe */
959 /*Zero(&coro->start_env, 1, JMPENV);*/
960 coro->start_env.je_ret = -1;
961 coro->start_env.je_mustcatch = TRUE;
962
963 RETVAL = coro;
964 OUTPUT: 983 OUTPUT:
965 RETVAL 984 RETVAL
966 985
967void 986void
968transfer(prev, next, flags) 987transfer (prev, next, flags)
969 SV *prev 988 SV *prev
970 SV *next 989 SV *next
971 int flags 990 int flags
972 PROTOTYPE: @
973 CODE: 991 CODE:
974 PUTBACK; 992 PUTBACK;
975 SV_CORO (next, "Coro::transfer");
976 SV_CORO (prev, "Coro::transfer");
977 transfer (aTHX_ SvSTATE (prev), SvSTATE (next), flags); 993 coro_state_transfer (aTHX_ SvSTATE (prev), SvSTATE (next), flags);
978 SPAGAIN; 994 SPAGAIN;
979 995
996int
997prio (Coro::State coro, int newprio = 0)
998 ALIAS:
999 nice = 1
1000 CODE:
1001{
1002 RETVAL = coro->prio;
1003
1004 if (items > 1)
1005 {
1006 if (ix)
1007 newprio += coro->prio;
1008
1009 if (newprio < PRIO_MIN) newprio = PRIO_MIN;
1010 if (newprio > PRIO_MAX) newprio = PRIO_MAX;
1011
1012 coro->prio = newprio;
1013 }
1014}
1015
980void 1016void
981DESTROY(coro) 1017_clear_idle_sp (Coro::State self)
982 Coro::State coro 1018 CODE:
983 CODE: 1019 self->stack->idle_sp = 0;
984
985 if (coro->mainstack && coro->mainstack != main_mainstack)
986 {
987 struct coro temp;
988
989 PUTBACK;
990 SAVE (aTHX_ (&temp), TRANSFER_SAVE_ALL);
991 LOAD (aTHX_ coro);
992 SPAGAIN;
993
994 destroy_stacks (aTHX);
995
996 LOAD ((&temp)); /* this will get rid of defsv etc.. */
997 SPAGAIN;
998
999 coro->mainstack = 0;
1000 }
1001
1002 deallocate_stack (coro);
1003 SvREFCNT_dec (coro->args);
1004 Safefree (coro);
1005 1020
1006void 1021void
1022_clone_state_from (SV *dst, SV *src)
1023 CODE:
1024{
1025 struct coro *coro_src = SvSTATE (src);
1026
1027 sv_unmagic (SvRV (dst), PERL_MAGIC_ext);
1028
1029 ++coro_src->refcnt;
1030 sv_magicext (SvRV (dst), 0, PERL_MAGIC_ext, &coro_state_vtbl, (char *)coro_src, 0)->mg_flags |= MGf_DUP;
1031}
1032
1033void
1007_exit(code) 1034_exit (code)
1008 int code 1035 int code
1009 PROTOTYPE: $ 1036 PROTOTYPE: $
1010 CODE: 1037 CODE:
1011 _exit (code); 1038 _exit (code);
1012 1039
1013MODULE = Coro::State PACKAGE = Coro::Cont 1040MODULE = Coro::State PACKAGE = Coro::Cont
1014 1041
1015# this is slightly dirty (should expose a c-level api)
1016
1017void 1042void
1018yield(...) 1043yield (...)
1019 PROTOTYPE: @ 1044 PROTOTYPE: @
1020 CODE: 1045 CODE:
1046{
1021 SV *yieldstack; 1047 SV *yieldstack;
1022 SV *sv; 1048 SV *sv;
1023 AV *defav = GvAV (PL_defgv); 1049 AV *defav = GvAV (PL_defgv);
1024 struct coro *prev, *next; 1050 struct coro *prev, *next;
1025 1051
1034 av_fill (defav, items - 1); 1060 av_fill (defav, items - 1);
1035 while (items--) 1061 while (items--)
1036 av_store (defav, items, SvREFCNT_inc (ST(items))); 1062 av_store (defav, items, SvREFCNT_inc (ST(items)));
1037 1063
1038 sv = av_pop ((AV *)SvRV (yieldstack)); 1064 sv = av_pop ((AV *)SvRV (yieldstack));
1039 prev = INT2PTR (struct coro *, SvIV ((SV*)SvRV (*av_fetch ((AV *)SvRV (sv), 0, 0)))); 1065 prev = SvSTATE (*av_fetch ((AV *)SvRV (sv), 0, 0));
1040 next = INT2PTR (struct coro *, SvIV ((SV*)SvRV (*av_fetch ((AV *)SvRV (sv), 1, 0)))); 1066 next = SvSTATE (*av_fetch ((AV *)SvRV (sv), 1, 0));
1041 SvREFCNT_dec (sv); 1067 SvREFCNT_dec (sv);
1042 1068
1043 transfer (aTHX_ prev, next, 0); 1069 coro_state_transfer (aTHX_ prev, next, 0);
1070}
1044 1071
1045MODULE = Coro::State PACKAGE = Coro 1072MODULE = Coro::State PACKAGE = Coro
1046 1073
1047# this is slightly dirty (should expose a c-level api)
1048
1049BOOT: 1074BOOT:
1050{ 1075{
1051 int i; 1076 int i;
1077
1052 HV *stash = gv_stashpv ("Coro", TRUE); 1078 coro_stash = gv_stashpv ("Coro", TRUE);
1053 1079
1054 newCONSTSUB (stash, "PRIO_MAX", newSViv (PRIO_MAX)); 1080 newCONSTSUB (coro_stash, "PRIO_MAX", newSViv (PRIO_MAX));
1055 newCONSTSUB (stash, "PRIO_HIGH", newSViv (PRIO_HIGH)); 1081 newCONSTSUB (coro_stash, "PRIO_HIGH", newSViv (PRIO_HIGH));
1056 newCONSTSUB (stash, "PRIO_NORMAL", newSViv (PRIO_NORMAL)); 1082 newCONSTSUB (coro_stash, "PRIO_NORMAL", newSViv (PRIO_NORMAL));
1057 newCONSTSUB (stash, "PRIO_LOW", newSViv (PRIO_LOW)); 1083 newCONSTSUB (coro_stash, "PRIO_LOW", newSViv (PRIO_LOW));
1058 newCONSTSUB (stash, "PRIO_IDLE", newSViv (PRIO_IDLE)); 1084 newCONSTSUB (coro_stash, "PRIO_IDLE", newSViv (PRIO_IDLE));
1059 newCONSTSUB (stash, "PRIO_MIN", newSViv (PRIO_MIN)); 1085 newCONSTSUB (coro_stash, "PRIO_MIN", newSViv (PRIO_MIN));
1060 1086
1061 coro_current = gv_fetchpv ("Coro::current", TRUE, SVt_PV); 1087 coro_current = gv_fetchpv ("Coro::current", TRUE, SVt_PV);
1062 coro_idle = gv_fetchpv ("Coro::idle" , TRUE, SVt_PV); 1088 coro_idle = gv_fetchpv ("Coro::idle" , TRUE, SVt_PV);
1063 1089
1064 for (i = PRIO_MAX - PRIO_MIN + 1; i--; ) 1090 for (i = PRIO_MAX - PRIO_MIN + 1; i--; )
1072 coroapi.ready = api_ready; 1098 coroapi.ready = api_ready;
1073 coroapi.nready = &coro_nready; 1099 coroapi.nready = &coro_nready;
1074 coroapi.current = coro_current; 1100 coroapi.current = coro_current;
1075 1101
1076 GCoroAPI = &coroapi; 1102 GCoroAPI = &coroapi;
1077 sv_setiv(sv, (IV)&coroapi); 1103 sv_setiv (sv, (IV)&coroapi);
1078 SvREADONLY_on(sv); 1104 SvREADONLY_on (sv);
1079 } 1105 }
1080} 1106}
1081 1107
1082#if !PERL_MICRO
1083
1084void 1108void
1085ready(self) 1109ready (SV *self)
1086 SV * self
1087 PROTOTYPE: $ 1110 PROTOTYPE: $
1088 CODE: 1111 CODE:
1089 api_ready (self); 1112 api_ready (self);
1090 1113
1091#endif
1092
1093int 1114int
1094nready(...) 1115nready (...)
1095 PROTOTYPE: 1116 PROTOTYPE:
1096 CODE: 1117 CODE:
1097 RETVAL = coro_nready; 1118 RETVAL = coro_nready;
1098 OUTPUT: 1119 OUTPUT:
1099 RETVAL 1120 RETVAL
1100 1121
1101void 1122void
1102schedule(...) 1123schedule (...)
1103 PROTOTYPE: 1124 PROTOTYPE:
1104 CODE: 1125 CODE:
1105 api_schedule (); 1126 api_schedule ();
1106 1127
1107void 1128void
1129_set_cede_self ()
1130 CODE:
1131 coro_cede_self = 1;
1132
1133void
1108cede(...) 1134cede (...)
1109 PROTOTYPE: 1135 PROTOTYPE:
1110 CODE: 1136 CODE:
1111 api_cede (); 1137 api_cede ();
1112 1138
1113# and these are hacks 1139MODULE = Coro::State PACKAGE = Coro::AIO
1140
1114SV * 1141SV *
1115_aio_get_state () 1142_get_state ()
1116 CODE: 1143 CODE:
1117{ 1144{
1118 struct { 1145 struct {
1119 int errorno; 1146 int errorno;
1120 int laststype; 1147 int laststype;
1131} 1158}
1132 OUTPUT: 1159 OUTPUT:
1133 RETVAL 1160 RETVAL
1134 1161
1135void 1162void
1136_aio_set_state (char *data_) 1163_set_state (char *data_)
1137 PROTOTYPE: $ 1164 PROTOTYPE: $
1138 CODE: 1165 CODE:
1139{ 1166{
1140 struct { 1167 struct {
1141 int errorno; 1168 int errorno;

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines