… | |
… | |
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 | |
85 | static struct CoroAPI coroapi; |
84 | static struct CoroAPI coroapi; |
86 | static AV *main_mainstack; /* used to differentiate between $main and others */ |
85 | static AV *main_mainstack; /* used to differentiate between $main and others */ |
87 | static HV *coro_state_stash; |
86 | static HV *coro_state_stash, *coro_stash; |
88 | static SV *ucoro_state_sv; |
|
|
89 | static U32 ucoro_state_hash; |
|
|
90 | static SV *coro_mortal; /* will be freed after next transfer */ |
87 | static 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 only the c stack but also c registers etc... */ |
93 | typedef struct { |
90 | typedef struct { |
94 | int refcnt; /* pointer reference counter */ |
91 | int refcnt; /* pointer reference counter */ |
… | |
… | |
780 | |
777 | |
781 | /* use this function pointer to call the above function */ |
778 | /* use this function pointer to call the above function */ |
782 | /* this is done to increase chances of the compiler not inlining the call */ |
779 | /* this is done to increase chances of the compiler not inlining the call */ |
783 | void (*coro_state_transfer)(pTHX_ struct coro *prev, struct coro *next, int flags) = transfer_impl; |
780 | void (*coro_state_transfer)(pTHX_ struct coro *prev, struct coro *next, int flags) = transfer_impl; |
784 | |
781 | |
785 | #define SV_CORO(sv,func) \ |
|
|
786 | do { \ |
|
|
787 | if (SvROK (sv)) \ |
|
|
788 | sv = SvRV (sv); \ |
|
|
789 | \ |
|
|
790 | if (SvTYPE (sv) == SVt_PVHV && SvSTASH (sv) != coro_state_stash) \ |
|
|
791 | { \ |
|
|
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 | |
|
|
806 | static void |
782 | static void |
807 | coro_state_destroy (struct coro *coro) |
783 | coro_state_destroy (struct coro *coro) |
808 | { |
784 | { |
809 | if (coro->refcnt--) |
785 | if (coro->refcnt--) |
810 | return; |
786 | return; |
… | |
… | |
852 | static MGVTBL coro_state_vtbl = { 0, 0, 0, 0, coro_state_clear, 0, coro_state_dup, 0 }; |
828 | static MGVTBL coro_state_vtbl = { 0, 0, 0, 0, coro_state_clear, 0, coro_state_dup, 0 }; |
853 | |
829 | |
854 | static struct coro * |
830 | static struct coro * |
855 | SvSTATE (SV *coro) |
831 | SvSTATE (SV *coro) |
856 | { |
832 | { |
857 | MAGIC *mg = SvMAGIC (SvROK (coro) ? SvRV (coro) : coro); |
833 | HV *stash; |
|
|
834 | MAGIC *mg; |
|
|
835 | |
|
|
836 | if (SvROK (coro)) |
|
|
837 | coro = SvRV (coro); |
|
|
838 | |
|
|
839 | stash = SvSTASH (coro); |
|
|
840 | if (stash != coro_stash && stash != coro_state_stash) |
|
|
841 | { |
|
|
842 | /* very slow, but rare, check */ |
|
|
843 | if (!sv_derived_from (sv_2mortal (newRV_inc (coro)), "Coro::State")) |
|
|
844 | croak ("Coro::State object required"); |
|
|
845 | } |
|
|
846 | |
|
|
847 | mg = SvMAGIC (coro); |
858 | assert (mg->mg_type == PERL_MAGIC_ext); |
848 | assert (mg->mg_type == PERL_MAGIC_ext); |
859 | return (struct coro *)mg->mg_ptr; |
849 | return (struct coro *)mg->mg_ptr; |
860 | } |
850 | } |
861 | |
851 | |
862 | static void |
852 | static void |
863 | api_transfer (pTHX_ SV *prev, SV *next, int flags) |
853 | api_transfer (pTHX_ SV *prev, SV *next, int flags) |
864 | { |
854 | { |
865 | SV_CORO (prev, "Coro::transfer"); |
|
|
866 | SV_CORO (next, "Coro::transfer"); |
|
|
867 | |
|
|
868 | coro_state_transfer (aTHX_ SvSTATE (prev), SvSTATE (next), flags); |
855 | coro_state_transfer (aTHX_ SvSTATE (prev), SvSTATE (next), flags); |
869 | } |
856 | } |
870 | |
857 | |
871 | /** Coro ********************************************************************/ |
858 | /** Coro ********************************************************************/ |
872 | |
859 | |
… | |
… | |
888 | int prio; |
875 | int prio; |
889 | |
876 | |
890 | if (SvTYPE (sv) != SVt_PVHV) |
877 | if (SvTYPE (sv) != SVt_PVHV) |
891 | croak ("Coro::ready tried to enqueue something that is not a coroutine"); |
878 | croak ("Coro::ready tried to enqueue something that is not a coroutine"); |
892 | |
879 | |
893 | { |
|
|
894 | SV *coro = sv; |
|
|
895 | SV_CORO (coro, "omg"); |
|
|
896 | prio = SvSTATE (coro)->prio; |
880 | prio = SvSTATE (sv)->prio; |
897 | } |
|
|
898 | |
881 | |
899 | av_push (coro_ready [prio - PRIO_MIN], sv); |
882 | av_push (coro_ready [prio - PRIO_MIN], sv); |
900 | coro_nready++; |
883 | coro_nready++; |
901 | } |
884 | } |
902 | |
885 | |
… | |
… | |
936 | api_schedule (void) |
919 | api_schedule (void) |
937 | { |
920 | { |
938 | dTHX; |
921 | dTHX; |
939 | |
922 | |
940 | SV *prev, *next; |
923 | SV *prev, *next; |
|
|
924 | SV *current = GvSV (coro_current); |
941 | |
925 | |
|
|
926 | for (;;) |
|
|
927 | { |
942 | LOCK; |
928 | LOCK; |
943 | |
929 | |
944 | prev = SvRV (GvSV (coro_current)); |
|
|
945 | next = coro_deq (aTHX_ PRIO_MIN); |
930 | next = coro_deq (aTHX_ PRIO_MIN); |
946 | |
931 | |
947 | if (!next) |
932 | if (next) |
948 | next = SvREFCNT_inc (SvRV (GvSV (coro_idle))); |
933 | break; |
|
|
934 | |
|
|
935 | UNLOCK; |
|
|
936 | |
|
|
937 | { |
|
|
938 | dSP; |
|
|
939 | |
|
|
940 | ENTER; |
|
|
941 | SAVETMPS; |
|
|
942 | |
|
|
943 | PUSHMARK (SP); |
|
|
944 | PUTBACK; |
|
|
945 | call_sv (GvSV (coro_idle), G_DISCARD); |
|
|
946 | |
|
|
947 | FREETMPS; |
|
|
948 | LEAVE; |
|
|
949 | } |
|
|
950 | } |
|
|
951 | |
|
|
952 | prev = SvRV (current); |
|
|
953 | SvRV (current) = next; |
949 | |
954 | |
950 | /* free this only after the transfer */ |
955 | /* free this only after the transfer */ |
951 | coro_mortal = prev; |
956 | coro_mortal = prev; |
952 | SV_CORO (prev, "Coro::schedule"); |
|
|
953 | |
|
|
954 | SvRV (GvSV (coro_current)) = next; |
|
|
955 | |
|
|
956 | SV_CORO (next, "Coro::schedule"); |
|
|
957 | |
957 | |
958 | UNLOCK; |
958 | UNLOCK; |
959 | |
959 | |
960 | coro_state_transfer (aTHX_ SvSTATE (prev), SvSTATE (next), |
960 | coro_state_transfer (aTHX_ SvSTATE (prev), SvSTATE (next), |
961 | TRANSFER_SAVE_ALL | TRANSFER_LAZY_STACK); |
961 | TRANSFER_SAVE_ALL | TRANSFER_LAZY_STACK); |
… | |
… | |
976 | MODULE = Coro::State PACKAGE = Coro::State |
976 | MODULE = Coro::State PACKAGE = Coro::State |
977 | |
977 | |
978 | PROTOTYPES: DISABLE |
978 | PROTOTYPES: DISABLE |
979 | |
979 | |
980 | BOOT: |
980 | BOOT: |
981 | { /* {} necessary for stoopid perl-5.6.x */ |
981 | { |
982 | #ifdef USE_ITHREADS |
982 | #ifdef USE_ITHREADS |
983 | MUTEX_INIT (&coro_mutex); |
983 | MUTEX_INIT (&coro_mutex); |
984 | #endif |
984 | #endif |
985 | BOOT_PAGESIZE; |
985 | BOOT_PAGESIZE; |
986 | |
986 | |
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); |
987 | coro_state_stash = gv_stashpv ("Coro::State", TRUE); |
990 | |
988 | |
991 | newCONSTSUB (coro_state_stash, "SAVE_DEFAV", newSViv (TRANSFER_SAVE_DEFAV)); |
989 | newCONSTSUB (coro_state_stash, "SAVE_DEFAV", newSViv (TRANSFER_SAVE_DEFAV)); |
992 | newCONSTSUB (coro_state_stash, "SAVE_DEFSV", newSViv (TRANSFER_SAVE_DEFSV)); |
990 | newCONSTSUB (coro_state_stash, "SAVE_DEFSV", newSViv (TRANSFER_SAVE_DEFSV)); |
993 | newCONSTSUB (coro_state_stash, "SAVE_ERRSV", newSViv (TRANSFER_SAVE_ERRSV)); |
991 | newCONSTSUB (coro_state_stash, "SAVE_ERRSV", newSViv (TRANSFER_SAVE_ERRSV)); |
… | |
… | |
1030 | SV *prev |
1028 | SV *prev |
1031 | SV *next |
1029 | SV *next |
1032 | int flags |
1030 | int flags |
1033 | CODE: |
1031 | CODE: |
1034 | PUTBACK; |
1032 | PUTBACK; |
1035 | SV_CORO (next, "Coro::transfer"); |
|
|
1036 | SV_CORO (prev, "Coro::transfer"); |
|
|
1037 | coro_state_transfer (aTHX_ SvSTATE (prev), SvSTATE (next), flags); |
1033 | coro_state_transfer (aTHX_ SvSTATE (prev), SvSTATE (next), flags); |
1038 | SPAGAIN; |
1034 | SPAGAIN; |
1039 | |
1035 | |
1040 | int |
1036 | int |
1041 | prio (Coro::State coro, int newprio = 0) |
1037 | prio (Coro::State coro, int newprio = 0) |
… | |
… | |
1080 | |
1076 | |
1081 | void |
1077 | void |
1082 | yield (...) |
1078 | yield (...) |
1083 | PROTOTYPE: @ |
1079 | PROTOTYPE: @ |
1084 | CODE: |
1080 | CODE: |
|
|
1081 | { |
1085 | SV *yieldstack; |
1082 | SV *yieldstack; |
1086 | SV *sv; |
1083 | SV *sv; |
1087 | AV *defav = GvAV (PL_defgv); |
1084 | AV *defav = GvAV (PL_defgv); |
1088 | struct coro *prev, *next; |
1085 | struct coro *prev, *next; |
1089 | |
1086 | |
… | |
… | |
1098 | av_fill (defav, items - 1); |
1095 | av_fill (defav, items - 1); |
1099 | while (items--) |
1096 | while (items--) |
1100 | av_store (defav, items, SvREFCNT_inc (ST(items))); |
1097 | av_store (defav, items, SvREFCNT_inc (ST(items))); |
1101 | |
1098 | |
1102 | sv = av_pop ((AV *)SvRV (yieldstack)); |
1099 | sv = av_pop ((AV *)SvRV (yieldstack)); |
1103 | prev = SvSTATE ((SV*)SvRV (*av_fetch ((AV *)SvRV (sv), 0, 0))); |
1100 | prev = SvSTATE (*av_fetch ((AV *)SvRV (sv), 0, 0)); |
1104 | next = SvSTATE ((SV*)SvRV (*av_fetch ((AV *)SvRV (sv), 1, 0))); |
1101 | next = SvSTATE (*av_fetch ((AV *)SvRV (sv), 1, 0)); |
1105 | SvREFCNT_dec (sv); |
1102 | SvREFCNT_dec (sv); |
1106 | |
1103 | |
1107 | coro_state_transfer (aTHX_ prev, next, 0); |
1104 | coro_state_transfer (aTHX_ prev, next, 0); |
|
|
1105 | } |
1108 | |
1106 | |
1109 | MODULE = Coro::State PACKAGE = Coro |
1107 | MODULE = Coro::State PACKAGE = Coro |
1110 | |
1108 | |
1111 | BOOT: |
1109 | BOOT: |
1112 | { |
1110 | { |
1113 | int i; |
1111 | int i; |
|
|
1112 | |
1114 | HV *stash = gv_stashpv ("Coro", TRUE); |
1113 | coro_stash = gv_stashpv ("Coro", TRUE); |
1115 | |
1114 | |
1116 | newCONSTSUB (stash, "PRIO_MAX", newSViv (PRIO_MAX)); |
1115 | newCONSTSUB (coro_stash, "PRIO_MAX", newSViv (PRIO_MAX)); |
1117 | newCONSTSUB (stash, "PRIO_HIGH", newSViv (PRIO_HIGH)); |
1116 | newCONSTSUB (coro_stash, "PRIO_HIGH", newSViv (PRIO_HIGH)); |
1118 | newCONSTSUB (stash, "PRIO_NORMAL", newSViv (PRIO_NORMAL)); |
1117 | newCONSTSUB (coro_stash, "PRIO_NORMAL", newSViv (PRIO_NORMAL)); |
1119 | newCONSTSUB (stash, "PRIO_LOW", newSViv (PRIO_LOW)); |
1118 | newCONSTSUB (coro_stash, "PRIO_LOW", newSViv (PRIO_LOW)); |
1120 | newCONSTSUB (stash, "PRIO_IDLE", newSViv (PRIO_IDLE)); |
1119 | newCONSTSUB (coro_stash, "PRIO_IDLE", newSViv (PRIO_IDLE)); |
1121 | newCONSTSUB (stash, "PRIO_MIN", newSViv (PRIO_MIN)); |
1120 | newCONSTSUB (coro_stash, "PRIO_MIN", newSViv (PRIO_MIN)); |
1122 | |
1121 | |
1123 | coro_current = gv_fetchpv ("Coro::current", TRUE, SVt_PV); |
1122 | coro_current = gv_fetchpv ("Coro::current", TRUE, SVt_PV); |
1124 | coro_idle = gv_fetchpv ("Coro::idle" , TRUE, SVt_PV); |
1123 | coro_idle = gv_fetchpv ("Coro::idle" , TRUE, SVt_PV); |
1125 | |
1124 | |
1126 | for (i = PRIO_MAX - PRIO_MIN + 1; i--; ) |
1125 | for (i = PRIO_MAX - PRIO_MIN + 1; i--; ) |