… | |
… | |
100 | void *sptr; |
100 | void *sptr; |
101 | long ssize; /* positive == mmap, otherwise malloc */ |
101 | long ssize; /* positive == mmap, otherwise malloc */ |
102 | } coro_stack; |
102 | } coro_stack; |
103 | |
103 | |
104 | struct coro { |
104 | struct coro { |
105 | /* the top-level JMPENV for each coroutine, needed to catch dies. */ |
|
|
106 | JMPENV start_env; |
|
|
107 | |
|
|
108 | /* the optional C context */ |
105 | /* the optional C context */ |
109 | coro_stack *stack; |
106 | coro_stack *stack; |
110 | void *cursp; |
107 | void *cursp; |
111 | int gencnt; |
108 | int gencnt; |
112 | |
109 | |
… | |
… | |
163 | AV *padlist = CvPADLIST (cv); |
160 | AV *padlist = CvPADLIST (cv); |
164 | AV *newpadlist, *newpad; |
161 | AV *newpadlist, *newpad; |
165 | |
162 | |
166 | newpadlist = newAV (); |
163 | newpadlist = newAV (); |
167 | AvREAL_off (newpadlist); |
164 | AvREAL_off (newpadlist); |
|
|
165 | #if PERL_VERSION < 9 |
168 | Perl_pad_push (aTHX_ padlist, AvFILLp (padlist) + 1, 1); |
166 | Perl_pad_push (aTHX_ padlist, AvFILLp (padlist) + 1, 1); |
|
|
167 | #else |
|
|
168 | Perl_pad_push (aTHX_ padlist, AvFILLp (padlist) + 1); |
|
|
169 | #endif |
169 | newpad = (AV *)AvARRAY (padlist)[AvFILLp (padlist)]; |
170 | newpad = (AV *)AvARRAY (padlist)[AvFILLp (padlist)]; |
170 | --AvFILLp (padlist); |
171 | --AvFILLp (padlist); |
171 | |
172 | |
172 | av_store (newpadlist, 0, SvREFCNT_inc (*av_fetch (padlist, 0, FALSE))); |
173 | av_store (newpadlist, 0, SvREFCNT_inc (*av_fetch (padlist, 0, FALSE))); |
173 | av_store (newpadlist, 1, (SV *)newpad); |
174 | av_store (newpadlist, 1, (SV *)newpad); |
… | |
… | |
625 | } |
626 | } |
626 | else |
627 | else |
627 | { |
628 | { |
628 | UNOP myop; |
629 | UNOP myop; |
629 | |
630 | |
630 | PL_op = (OP *)&myop; |
|
|
631 | |
|
|
632 | Zero(&myop, 1, UNOP); |
631 | Zero(&myop, 1, UNOP); |
633 | myop.op_next = Nullop; |
632 | myop.op_next = Nullop; |
634 | myop.op_flags = OPf_WANT_VOID; |
633 | myop.op_flags = OPf_WANT_VOID; |
|
|
634 | |
|
|
635 | PL_op = (OP *)&myop; |
635 | |
636 | |
636 | PUSHMARK(SP); |
637 | PUSHMARK(SP); |
637 | XPUSHs (sub_init); |
638 | XPUSHs (sub_init); |
638 | /* |
639 | /* |
639 | * the next line is slightly wrong, as PL_op->op_next |
640 | * the next line is slightly wrong, as PL_op->op_next |
… | |
… | |
657 | * this is a _very_ stripped down perl interpreter ;) |
658 | * this is a _very_ stripped down perl interpreter ;) |
658 | */ |
659 | */ |
659 | dTHX; |
660 | dTHX; |
660 | Coro__State ctx = (Coro__State)arg; |
661 | Coro__State ctx = (Coro__State)arg; |
661 | |
662 | |
662 | PL_top_env = &ctx->start_env; |
663 | PL_top_env = &PL_start_env; |
663 | |
664 | |
664 | ctx->cursp = 0; |
665 | ctx->cursp = 0; |
665 | PL_op = PL_op->op_next; |
666 | PL_op = PL_op->op_next; |
666 | CALLRUNOPS(aTHX); |
667 | CALLRUNOPS(aTHX); |
667 | |
668 | |
… | |
… | |
673 | { |
674 | { |
674 | dSTACKLEVEL; |
675 | dSTACKLEVEL; |
675 | |
676 | |
676 | if (prev != next) |
677 | if (prev != next) |
677 | { |
678 | { |
|
|
679 | /* has this coro been created yet? */ |
678 | if (next->mainstack) |
680 | if (next->mainstack) |
679 | { |
681 | { |
680 | LOCK; |
682 | LOCK; |
681 | SAVE (prev, flags); |
683 | SAVE (prev, flags); |
682 | LOAD (next); |
684 | LOAD (next); |
… | |
… | |
721 | { |
723 | { |
722 | LOCK; |
724 | LOCK; |
723 | SAVE (prev, -1); /* first get rid of the old state */ |
725 | SAVE (prev, -1); /* first get rid of the old state */ |
724 | UNLOCK; |
726 | UNLOCK; |
725 | |
727 | |
|
|
728 | /* create the coroutine for the first time */ |
726 | if (flags & TRANSFER_SAVE_CCTXT) |
729 | if (flags & TRANSFER_SAVE_CCTXT) |
727 | { |
730 | { |
728 | if (!prev->stack) |
731 | if (!prev->stack) |
729 | allocate_stack (prev, 0); |
732 | allocate_stack (prev, 0); |
730 | |
733 | |
|
|
734 | /* the new coroutine starts with start_env again */ |
|
|
735 | PL_top_env = &PL_start_env; |
|
|
736 | |
731 | if (prev->stack->sptr && flags & TRANSFER_LAZY_STACK) |
737 | if (prev->stack->sptr && flags & TRANSFER_LAZY_STACK) |
732 | { |
738 | { |
733 | PL_top_env = &next->start_env; |
|
|
734 | |
|
|
735 | setup_coro (next); |
739 | setup_coro (next); |
736 | next->cursp = stacklevel; |
740 | next->cursp = stacklevel; |
737 | |
741 | |
738 | prev->stack->refcnt++; |
742 | prev->stack->refcnt++; |
739 | prev->stack->usecnt++; |
743 | prev->stack->usecnt++; |
… | |
… | |
788 | if (!SvOBJECT (sv) || SvSTASH (sv) != coro_state_stash) \ |
792 | if (!SvOBJECT (sv) || SvSTASH (sv) != coro_state_stash) \ |
789 | croak ("%s() -- %s is not (and contains not) a Coro::State object", func, # sv); \ |
793 | croak ("%s() -- %s is not (and contains not) a Coro::State object", func, # sv); \ |
790 | \ |
794 | \ |
791 | } while(0) |
795 | } while(0) |
792 | |
796 | |
793 | #define SvSTATE(sv) INT2PTR (struct coro *, SvIV (sv)) |
797 | #define SvSTATE(sv) INT2PTR (struct coro *, SvIVX (sv)) |
794 | |
798 | |
795 | static void |
799 | static void |
796 | api_transfer(pTHX_ SV *prev, SV *next, int flags) |
800 | api_transfer(pTHX_ SV *prev, SV *next, int flags) |
797 | { |
801 | { |
798 | SV_CORO (prev, "Coro::transfer"); |
802 | SV_CORO (prev, "Coro::transfer"); |
… | |
… | |
810 | #define PRIO_IDLE -3 |
814 | #define PRIO_IDLE -3 |
811 | #define PRIO_MIN -4 |
815 | #define PRIO_MIN -4 |
812 | |
816 | |
813 | /* for Coro.pm */ |
817 | /* for Coro.pm */ |
814 | static GV *coro_current, *coro_idle; |
818 | static GV *coro_current, *coro_idle; |
815 | static AV *coro_ready[PRIO_MAX-PRIO_MIN+1]; |
819 | static AV *coro_ready [PRIO_MAX-PRIO_MIN+1]; |
816 | static int coro_nready; |
820 | static int coro_nready; |
817 | |
821 | |
818 | static void |
822 | static void |
819 | coro_enq (pTHX_ SV *sv) |
823 | coro_enq (pTHX_ SV *sv) |
820 | { |
824 | { |
… | |
… | |
843 | min_prio -= PRIO_MIN; |
847 | min_prio -= PRIO_MIN; |
844 | if (min_prio < 0) |
848 | if (min_prio < 0) |
845 | min_prio = 0; |
849 | min_prio = 0; |
846 | |
850 | |
847 | for (prio = PRIO_MAX - PRIO_MIN + 1; --prio >= min_prio; ) |
851 | for (prio = PRIO_MAX - PRIO_MIN + 1; --prio >= min_prio; ) |
848 | if (av_len (coro_ready[prio]) >= 0) |
852 | if (AvFILLp (coro_ready [prio]) >= 0) |
849 | { |
853 | { |
850 | coro_nready--; |
854 | coro_nready--; |
851 | return av_shift (coro_ready[prio]); |
855 | return av_shift (coro_ready [prio]); |
852 | } |
856 | } |
853 | |
857 | |
854 | return 0; |
858 | return 0; |
855 | } |
859 | } |
856 | |
860 | |
… | |
… | |
947 | Newz (0, coro, 1, struct coro); |
951 | Newz (0, coro, 1, struct coro); |
948 | |
952 | |
949 | coro->args = (AV *)SvREFCNT_inc (SvRV (args)); |
953 | coro->args = (AV *)SvREFCNT_inc (SvRV (args)); |
950 | /*coro->mainstack = 0; *//*actual work is done inside transfer */ |
954 | /*coro->mainstack = 0; *//*actual work is done inside transfer */ |
951 | /*coro->stack = 0;*/ |
955 | /*coro->stack = 0;*/ |
952 | |
|
|
953 | /* same as JMPENV_BOOTSTRAP */ |
|
|
954 | /* we might be able to recycle start_env, but safe is safe */ |
|
|
955 | /*Zero(&coro->start_env, 1, JMPENV);*/ |
|
|
956 | coro->start_env.je_ret = -1; |
|
|
957 | coro->start_env.je_mustcatch = TRUE; |
|
|
958 | |
956 | |
959 | RETVAL = coro; |
957 | RETVAL = coro; |
960 | OUTPUT: |
958 | OUTPUT: |
961 | RETVAL |
959 | RETVAL |
962 | |
960 | |
… | |
… | |
1006 | CODE: |
1004 | CODE: |
1007 | _exit (code); |
1005 | _exit (code); |
1008 | |
1006 | |
1009 | MODULE = Coro::State PACKAGE = Coro::Cont |
1007 | MODULE = Coro::State PACKAGE = Coro::Cont |
1010 | |
1008 | |
1011 | # this is slightly dirty (should expose a c-level api) |
|
|
1012 | |
|
|
1013 | void |
1009 | void |
1014 | yield(...) |
1010 | yield(...) |
1015 | PROTOTYPE: @ |
1011 | PROTOTYPE: @ |
1016 | CODE: |
1012 | CODE: |
1017 | SV *yieldstack; |
1013 | SV *yieldstack; |
… | |
… | |
1030 | av_fill (defav, items - 1); |
1026 | av_fill (defav, items - 1); |
1031 | while (items--) |
1027 | while (items--) |
1032 | av_store (defav, items, SvREFCNT_inc (ST(items))); |
1028 | av_store (defav, items, SvREFCNT_inc (ST(items))); |
1033 | |
1029 | |
1034 | sv = av_pop ((AV *)SvRV (yieldstack)); |
1030 | sv = av_pop ((AV *)SvRV (yieldstack)); |
1035 | prev = INT2PTR (struct coro *, SvIV ((SV*)SvRV (*av_fetch ((AV *)SvRV (sv), 0, 0)))); |
1031 | prev = SvSTATE ((SV*)SvRV (*av_fetch ((AV *)SvRV (sv), 0, 0))); |
1036 | next = INT2PTR (struct coro *, SvIV ((SV*)SvRV (*av_fetch ((AV *)SvRV (sv), 1, 0)))); |
1032 | next = SvSTATE ((SV*)SvRV (*av_fetch ((AV *)SvRV (sv), 1, 0))); |
1037 | SvREFCNT_dec (sv); |
1033 | SvREFCNT_dec (sv); |
1038 | |
1034 | |
1039 | transfer (aTHX_ prev, next, 0); |
1035 | transfer (aTHX_ prev, next, 0); |
1040 | |
1036 | |
1041 | MODULE = Coro::State PACKAGE = Coro |
1037 | MODULE = Coro::State PACKAGE = Coro |
1042 | |
|
|
1043 | # this is slightly dirty (should expose a c-level api) |
|
|
1044 | |
1038 | |
1045 | BOOT: |
1039 | BOOT: |
1046 | { |
1040 | { |
1047 | int i; |
1041 | int i; |
1048 | HV *stash = gv_stashpv ("Coro", TRUE); |
1042 | HV *stash = gv_stashpv ("Coro", TRUE); |
… | |
… | |
1068 | coroapi.ready = api_ready; |
1062 | coroapi.ready = api_ready; |
1069 | coroapi.nready = &coro_nready; |
1063 | coroapi.nready = &coro_nready; |
1070 | coroapi.current = coro_current; |
1064 | coroapi.current = coro_current; |
1071 | |
1065 | |
1072 | GCoroAPI = &coroapi; |
1066 | GCoroAPI = &coroapi; |
1073 | sv_setiv(sv, (IV)&coroapi); |
1067 | sv_setiv (sv, (IV)&coroapi); |
1074 | SvREADONLY_on(sv); |
1068 | SvREADONLY_on (sv); |
1075 | } |
1069 | } |
1076 | } |
1070 | } |
1077 | |
1071 | |
1078 | #if !PERL_MICRO |
1072 | #if !PERL_MICRO |
1079 | |
1073 | |