… | |
… | |
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 | |
… | |
… | |
629 | } |
626 | } |
630 | else |
627 | else |
631 | { |
628 | { |
632 | UNOP myop; |
629 | UNOP myop; |
633 | |
630 | |
634 | PL_op = (OP *)&myop; |
|
|
635 | |
|
|
636 | Zero(&myop, 1, UNOP); |
631 | Zero(&myop, 1, UNOP); |
637 | myop.op_next = Nullop; |
632 | myop.op_next = Nullop; |
638 | myop.op_flags = OPf_WANT_VOID; |
633 | myop.op_flags = OPf_WANT_VOID; |
|
|
634 | |
|
|
635 | PL_op = (OP *)&myop; |
639 | |
636 | |
640 | PUSHMARK(SP); |
637 | PUSHMARK(SP); |
641 | XPUSHs (sub_init); |
638 | XPUSHs (sub_init); |
642 | /* |
639 | /* |
643 | * the next line is slightly wrong, as PL_op->op_next |
640 | * the next line is slightly wrong, as PL_op->op_next |
… | |
… | |
661 | * this is a _very_ stripped down perl interpreter ;) |
658 | * this is a _very_ stripped down perl interpreter ;) |
662 | */ |
659 | */ |
663 | dTHX; |
660 | dTHX; |
664 | Coro__State ctx = (Coro__State)arg; |
661 | Coro__State ctx = (Coro__State)arg; |
665 | |
662 | |
666 | PL_top_env = &ctx->start_env; |
663 | PL_top_env = &PL_start_env; |
667 | |
664 | |
668 | ctx->cursp = 0; |
665 | ctx->cursp = 0; |
669 | PL_op = PL_op->op_next; |
666 | PL_op = PL_op->op_next; |
670 | CALLRUNOPS(aTHX); |
667 | CALLRUNOPS(aTHX); |
671 | |
668 | |
672 | abort (); |
669 | abort (); |
673 | } |
670 | } |
674 | |
671 | |
|
|
672 | /* never call directly, always through the coro_state_transfer global variable */ |
675 | static void |
673 | static void |
676 | transfer (pTHX_ struct coro *prev, struct coro *next, int flags) |
674 | transfer_impl (pTHX_ struct coro *prev, struct coro *next, int flags) |
677 | { |
675 | { |
678 | dSTACKLEVEL; |
676 | dSTACKLEVEL; |
679 | |
677 | |
680 | if (prev != next) |
678 | if (prev != next) |
681 | { |
679 | { |
|
|
680 | /* has this coro been created yet? */ |
682 | if (next->mainstack) |
681 | if (next->mainstack) |
683 | { |
682 | { |
684 | LOCK; |
683 | LOCK; |
685 | SAVE (prev, flags); |
684 | SAVE (prev, flags); |
686 | LOAD (next); |
685 | LOAD (next); |
… | |
… | |
725 | { |
724 | { |
726 | LOCK; |
725 | LOCK; |
727 | SAVE (prev, -1); /* first get rid of the old state */ |
726 | SAVE (prev, -1); /* first get rid of the old state */ |
728 | UNLOCK; |
727 | UNLOCK; |
729 | |
728 | |
|
|
729 | /* create the coroutine for the first time */ |
730 | if (flags & TRANSFER_SAVE_CCTXT) |
730 | if (flags & TRANSFER_SAVE_CCTXT) |
731 | { |
731 | { |
732 | if (!prev->stack) |
732 | if (!prev->stack) |
733 | allocate_stack (prev, 0); |
733 | allocate_stack (prev, 0); |
734 | |
734 | |
|
|
735 | /* the new coroutine starts with start_env again */ |
|
|
736 | PL_top_env = &PL_start_env; |
|
|
737 | |
735 | if (prev->stack->sptr && flags & TRANSFER_LAZY_STACK) |
738 | if (prev->stack->sptr && flags & TRANSFER_LAZY_STACK) |
736 | { |
739 | { |
737 | PL_top_env = &next->start_env; |
|
|
738 | |
|
|
739 | setup_coro (next); |
740 | setup_coro (next); |
740 | next->cursp = stacklevel; |
741 | next->cursp = stacklevel; |
741 | |
742 | |
742 | prev->stack->refcnt++; |
743 | prev->stack->refcnt++; |
743 | prev->stack->usecnt++; |
744 | prev->stack->usecnt++; |
… | |
… | |
771 | coro_mortal = 0; |
772 | coro_mortal = 0; |
772 | } |
773 | } |
773 | UNLOCK; |
774 | UNLOCK; |
774 | } |
775 | } |
775 | |
776 | |
|
|
777 | /* use this function pointer to call the above function */ |
|
|
778 | /* this is done to increase chances of the compiler not inlining the call */ |
|
|
779 | void (*coro_state_transfer)(pTHX_ struct coro *prev, struct coro *next, int flags) = transfer_impl; |
|
|
780 | |
776 | #define SV_CORO(sv,func) \ |
781 | #define SV_CORO(sv,func) \ |
777 | do { \ |
782 | do { \ |
778 | if (SvROK (sv)) \ |
783 | if (SvROK (sv)) \ |
779 | sv = SvRV (sv); \ |
784 | sv = SvRV (sv); \ |
780 | \ |
785 | \ |
… | |
… | |
792 | if (!SvOBJECT (sv) || SvSTASH (sv) != coro_state_stash) \ |
797 | if (!SvOBJECT (sv) || SvSTASH (sv) != coro_state_stash) \ |
793 | croak ("%s() -- %s is not (and contains not) a Coro::State object", func, # sv); \ |
798 | croak ("%s() -- %s is not (and contains not) a Coro::State object", func, # sv); \ |
794 | \ |
799 | \ |
795 | } while(0) |
800 | } while(0) |
796 | |
801 | |
797 | #define SvSTATE(sv) INT2PTR (struct coro *, SvIV (sv)) |
802 | #define SvSTATE(sv) INT2PTR (struct coro *, SvIVX (sv)) |
798 | |
803 | |
799 | static void |
804 | static void |
800 | api_transfer(pTHX_ SV *prev, SV *next, int flags) |
805 | api_transfer (pTHX_ SV *prev, SV *next, int flags) |
801 | { |
806 | { |
802 | SV_CORO (prev, "Coro::transfer"); |
807 | SV_CORO (prev, "Coro::transfer"); |
803 | SV_CORO (next, "Coro::transfer"); |
808 | SV_CORO (next, "Coro::transfer"); |
804 | |
809 | |
805 | transfer (aTHX_ SvSTATE (prev), SvSTATE (next), flags); |
810 | coro_state_transfer (aTHX_ SvSTATE (prev), SvSTATE (next), flags); |
806 | } |
811 | } |
807 | |
812 | |
808 | /** Coro ********************************************************************/ |
813 | /** Coro ********************************************************************/ |
809 | |
814 | |
810 | #define PRIO_MAX 3 |
815 | #define PRIO_MAX 3 |
… | |
… | |
814 | #define PRIO_IDLE -3 |
819 | #define PRIO_IDLE -3 |
815 | #define PRIO_MIN -4 |
820 | #define PRIO_MIN -4 |
816 | |
821 | |
817 | /* for Coro.pm */ |
822 | /* for Coro.pm */ |
818 | static GV *coro_current, *coro_idle; |
823 | static GV *coro_current, *coro_idle; |
819 | static AV *coro_ready[PRIO_MAX-PRIO_MIN+1]; |
824 | static AV *coro_ready [PRIO_MAX-PRIO_MIN+1]; |
820 | static int coro_nready; |
825 | static int coro_nready; |
821 | |
826 | |
822 | static void |
827 | static void |
823 | coro_enq (pTHX_ SV *sv) |
828 | coro_enq (pTHX_ SV *sv) |
824 | { |
829 | { |
… | |
… | |
847 | min_prio -= PRIO_MIN; |
852 | min_prio -= PRIO_MIN; |
848 | if (min_prio < 0) |
853 | if (min_prio < 0) |
849 | min_prio = 0; |
854 | min_prio = 0; |
850 | |
855 | |
851 | for (prio = PRIO_MAX - PRIO_MIN + 1; --prio >= min_prio; ) |
856 | for (prio = PRIO_MAX - PRIO_MIN + 1; --prio >= min_prio; ) |
852 | if (av_len (coro_ready[prio]) >= 0) |
857 | if (AvFILLp (coro_ready [prio]) >= 0) |
853 | { |
858 | { |
854 | coro_nready--; |
859 | coro_nready--; |
855 | return av_shift (coro_ready[prio]); |
860 | return av_shift (coro_ready [prio]); |
856 | } |
861 | } |
857 | |
862 | |
858 | return 0; |
863 | return 0; |
859 | } |
864 | } |
860 | |
865 | |
… | |
… | |
894 | |
899 | |
895 | SV_CORO (next, "Coro::schedule"); |
900 | SV_CORO (next, "Coro::schedule"); |
896 | |
901 | |
897 | UNLOCK; |
902 | UNLOCK; |
898 | |
903 | |
899 | transfer (aTHX_ SvSTATE (prev), SvSTATE (next), |
904 | coro_state_transfer (aTHX_ SvSTATE (prev), SvSTATE (next), |
900 | TRANSFER_SAVE_ALL | TRANSFER_LAZY_STACK); |
905 | TRANSFER_SAVE_ALL | TRANSFER_LAZY_STACK); |
901 | } |
906 | } |
902 | |
907 | |
903 | static void |
908 | static void |
904 | api_cede (void) |
909 | api_cede (void) |
905 | { |
910 | { |
… | |
… | |
937 | coroapi.ver = CORO_API_VERSION; |
942 | coroapi.ver = CORO_API_VERSION; |
938 | coroapi.transfer = api_transfer; |
943 | coroapi.transfer = api_transfer; |
939 | } |
944 | } |
940 | |
945 | |
941 | Coro::State |
946 | Coro::State |
942 | _newprocess(args) |
947 | new (char *klass, ...) |
943 | SV * args |
|
|
944 | PROTOTYPE: $ |
948 | PROTOTYPE: $@ |
945 | CODE: |
949 | CODE: |
|
|
950 | { |
946 | Coro__State coro; |
951 | Coro__State coro; |
|
|
952 | int i; |
947 | |
953 | |
948 | if (!SvROK (args) || SvTYPE (SvRV (args)) != SVt_PVAV) |
954 | if (!SvOK (ST (1))) |
949 | croak ("Coro::State::_newprocess expects an arrayref"); |
955 | croak ("Coro::State::new needs something callable as first argument"); |
950 | |
956 | |
951 | Newz (0, coro, 1, struct coro); |
957 | Newz (0, coro, 1, struct coro); |
|
|
958 | coro->args = newAV (); |
952 | |
959 | |
953 | coro->args = (AV *)SvREFCNT_inc (SvRV (args)); |
960 | for (i = 1; i < items; i++) |
|
|
961 | av_push (coro->args, newSVsv (ST (i))); |
|
|
962 | |
|
|
963 | RETVAL = coro; |
|
|
964 | |
954 | /*coro->mainstack = 0; *//*actual work is done inside transfer */ |
965 | /*coro->mainstack = 0; *//*actual work is done inside transfer */ |
955 | /*coro->stack = 0;*/ |
966 | /*coro->stack = 0;*/ |
956 | |
967 | } |
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: |
968 | OUTPUT: |
965 | RETVAL |
969 | RETVAL |
966 | |
970 | |
967 | void |
971 | void |
968 | transfer(prev, next, flags) |
972 | transfer(prev, next, flags) |
… | |
… | |
972 | PROTOTYPE: @ |
976 | PROTOTYPE: @ |
973 | CODE: |
977 | CODE: |
974 | PUTBACK; |
978 | PUTBACK; |
975 | SV_CORO (next, "Coro::transfer"); |
979 | SV_CORO (next, "Coro::transfer"); |
976 | SV_CORO (prev, "Coro::transfer"); |
980 | SV_CORO (prev, "Coro::transfer"); |
977 | transfer (aTHX_ SvSTATE (prev), SvSTATE (next), flags); |
981 | coro_state_transfer (aTHX_ SvSTATE (prev), SvSTATE (next), flags); |
978 | SPAGAIN; |
982 | SPAGAIN; |
979 | |
983 | |
980 | void |
984 | void |
981 | DESTROY(coro) |
985 | DESTROY(coro) |
982 | Coro::State coro |
986 | Coro::State coro |
… | |
… | |
1009 | PROTOTYPE: $ |
1013 | PROTOTYPE: $ |
1010 | CODE: |
1014 | CODE: |
1011 | _exit (code); |
1015 | _exit (code); |
1012 | |
1016 | |
1013 | MODULE = Coro::State PACKAGE = Coro::Cont |
1017 | MODULE = Coro::State PACKAGE = Coro::Cont |
1014 | |
|
|
1015 | # this is slightly dirty (should expose a c-level api) |
|
|
1016 | |
1018 | |
1017 | void |
1019 | void |
1018 | yield(...) |
1020 | yield(...) |
1019 | PROTOTYPE: @ |
1021 | PROTOTYPE: @ |
1020 | CODE: |
1022 | CODE: |
… | |
… | |
1034 | av_fill (defav, items - 1); |
1036 | av_fill (defav, items - 1); |
1035 | while (items--) |
1037 | while (items--) |
1036 | av_store (defav, items, SvREFCNT_inc (ST(items))); |
1038 | av_store (defav, items, SvREFCNT_inc (ST(items))); |
1037 | |
1039 | |
1038 | sv = av_pop ((AV *)SvRV (yieldstack)); |
1040 | sv = av_pop ((AV *)SvRV (yieldstack)); |
1039 | prev = INT2PTR (struct coro *, SvIV ((SV*)SvRV (*av_fetch ((AV *)SvRV (sv), 0, 0)))); |
1041 | prev = SvSTATE ((SV*)SvRV (*av_fetch ((AV *)SvRV (sv), 0, 0))); |
1040 | next = INT2PTR (struct coro *, SvIV ((SV*)SvRV (*av_fetch ((AV *)SvRV (sv), 1, 0)))); |
1042 | next = SvSTATE ((SV*)SvRV (*av_fetch ((AV *)SvRV (sv), 1, 0))); |
1041 | SvREFCNT_dec (sv); |
1043 | SvREFCNT_dec (sv); |
1042 | |
1044 | |
1043 | transfer (aTHX_ prev, next, 0); |
1045 | coro_state_transfer (aTHX_ prev, next, 0); |
1044 | |
1046 | |
1045 | MODULE = Coro::State PACKAGE = Coro |
1047 | MODULE = Coro::State PACKAGE = Coro |
1046 | |
|
|
1047 | # this is slightly dirty (should expose a c-level api) |
|
|
1048 | |
1048 | |
1049 | BOOT: |
1049 | BOOT: |
1050 | { |
1050 | { |
1051 | int i; |
1051 | int i; |
1052 | HV *stash = gv_stashpv ("Coro", TRUE); |
1052 | HV *stash = gv_stashpv ("Coro", TRUE); |
… | |
… | |
1072 | coroapi.ready = api_ready; |
1072 | coroapi.ready = api_ready; |
1073 | coroapi.nready = &coro_nready; |
1073 | coroapi.nready = &coro_nready; |
1074 | coroapi.current = coro_current; |
1074 | coroapi.current = coro_current; |
1075 | |
1075 | |
1076 | GCoroAPI = &coroapi; |
1076 | GCoroAPI = &coroapi; |
1077 | sv_setiv(sv, (IV)&coroapi); |
1077 | sv_setiv (sv, (IV)&coroapi); |
1078 | SvREADONLY_on(sv); |
1078 | SvREADONLY_on (sv); |
1079 | } |
1079 | } |
1080 | } |
1080 | } |
1081 | |
1081 | |
1082 | #if !PERL_MICRO |
1082 | #if !PERL_MICRO |
1083 | |
1083 | |