… | |
… | |
246 | /* state data */ |
246 | /* state data */ |
247 | struct CoroSLF slf_frame; /* saved slf frame */ |
247 | struct CoroSLF slf_frame; /* saved slf frame */ |
248 | AV *mainstack; |
248 | AV *mainstack; |
249 | perl_slots *slot; /* basically the saved sp */ |
249 | perl_slots *slot; /* basically the saved sp */ |
250 | |
250 | |
|
|
251 | CV *startcv; /* the CV to execute */ |
251 | AV *args; /* data associated with this coroutine (initial args) */ |
252 | AV *args; /* data associated with this coroutine (initial args) */ |
252 | int refcnt; /* coroutines are refcounted, yes */ |
253 | int refcnt; /* coroutines are refcounted, yes */ |
253 | int flags; /* CF_ flags */ |
254 | int flags; /* CF_ flags */ |
254 | HV *hv; /* the perl hash associated with this coro, if any */ |
255 | HV *hv; /* the perl hash associated with this coro, if any */ |
255 | void (*on_destroy)(pTHX_ struct coro *coro); |
256 | void (*on_destroy)(pTHX_ struct coro *coro); |
256 | |
257 | |
257 | /* statistics */ |
258 | /* statistics */ |
258 | int usecount; /* number of transfers to this coro */ |
259 | int usecount; /* number of transfers to this coro */ |
259 | |
260 | |
… | |
… | |
321 | #if PERL_VERSION_ATLEAST (5,10,0) |
322 | #if PERL_VERSION_ATLEAST (5,10,0) |
322 | /* silence stupid and wrong 5.10 warning that I am unable to switch off */ |
323 | /* silence stupid and wrong 5.10 warning that I am unable to switch off */ |
323 | get_hv (name, create); |
324 | get_hv (name, create); |
324 | #endif |
325 | #endif |
325 | return get_hv (name, create); |
326 | return get_hv (name, create); |
|
|
327 | } |
|
|
328 | |
|
|
329 | /* may croak */ |
|
|
330 | INLINE CV * |
|
|
331 | coro_sv_2cv (SV *sv) |
|
|
332 | { |
|
|
333 | HV *st; |
|
|
334 | GV *gvp; |
|
|
335 | return sv_2cv (sv, &st, &gvp, 0); |
326 | } |
336 | } |
327 | |
337 | |
328 | static AV * |
338 | static AV * |
329 | coro_clone_padlist (pTHX_ CV *cv) |
339 | coro_clone_padlist (pTHX_ CV *cv) |
330 | { |
340 | { |
… | |
… | |
861 | dSP; |
871 | dSP; |
862 | UNOP myop; |
872 | UNOP myop; |
863 | |
873 | |
864 | Zero (&myop, 1, UNOP); |
874 | Zero (&myop, 1, UNOP); |
865 | myop.op_next = Nullop; |
875 | myop.op_next = Nullop; |
|
|
876 | myop.op_type = OP_ENTERSUB; |
866 | myop.op_flags = OPf_WANT_VOID; |
877 | myop.op_flags = OPf_WANT_VOID; |
867 | |
878 | |
868 | PUSHMARK (SP); |
879 | PUSHMARK (SP); |
869 | XPUSHs (sv_2mortal (av_shift (GvAV (PL_defgv)))); |
880 | PUSHs ((SV *)coro->startcv); |
870 | PUTBACK; |
881 | PUTBACK; |
871 | PL_op = (OP *)&myop; |
882 | PL_op = (OP *)&myop; |
872 | PL_op = PL_ppaddr[OP_ENTERSUB](aTHX); |
883 | PL_op = PL_ppaddr[OP_ENTERSUB](aTHX); |
873 | SPAGAIN; |
|
|
874 | } |
884 | } |
875 | |
885 | |
876 | /* this newly created coroutine might be run on an existing cctx which most |
886 | /* this newly created coroutine might be run on an existing cctx which most |
877 | * likely was suspended in pp_slf, so we have to emulate entering pp_slf here. |
887 | * likely was suspended in pp_slf, so we have to emulate entering pp_slf here. |
878 | */ |
888 | */ |
… | |
… | |
881 | |
891 | |
882 | /* and we have to provide the pp_slf op in any case, so pp_slf can skip it */ |
892 | /* and we have to provide the pp_slf op in any case, so pp_slf can skip it */ |
883 | coro_setup_op.op_next = PL_op; |
893 | coro_setup_op.op_next = PL_op; |
884 | coro_setup_op.op_type = OP_CUSTOM; |
894 | coro_setup_op.op_type = OP_CUSTOM; |
885 | coro_setup_op.op_ppaddr = pp_slf; |
895 | coro_setup_op.op_ppaddr = pp_slf; |
886 | /* no flags required, as an init function won't be called */ |
896 | /* no flags etc. required, as an init function won't be called */ |
887 | |
897 | |
888 | PL_op = (OP *)&coro_setup_op; |
898 | PL_op = (OP *)&coro_setup_op; |
889 | |
899 | |
890 | /* copy throw, in case it was set before coro_setup */ |
900 | /* copy throw, in case it was set before coro_setup */ |
891 | CORO_THROW = coro->except; |
901 | CORO_THROW = coro->except; |
… | |
… | |
919 | SvREFCNT_dec (GvSV (irsgv)); |
929 | SvREFCNT_dec (GvSV (irsgv)); |
920 | |
930 | |
921 | SvREFCNT_dec (PL_diehook); |
931 | SvREFCNT_dec (PL_diehook); |
922 | SvREFCNT_dec (PL_warnhook); |
932 | SvREFCNT_dec (PL_warnhook); |
923 | |
933 | |
924 | SvREFCNT_dec (CORO_THROW); |
|
|
925 | SvREFCNT_dec (coro->saved_deffh); |
934 | SvREFCNT_dec (coro->saved_deffh); |
926 | SvREFCNT_dec (coro->rouse_cb); |
935 | SvREFCNT_dec (coro->rouse_cb); |
927 | |
936 | |
928 | coro_destruct_stacks (aTHX); |
937 | coro_destruct_stacks (aTHX); |
929 | } |
938 | } |
… | |
… | |
1018 | SAVETMPS; |
1027 | SAVETMPS; |
1019 | EXTEND (SP, 3); |
1028 | EXTEND (SP, 3); |
1020 | PUSHMARK (SP); |
1029 | PUSHMARK (SP); |
1021 | PUSHs (&PL_sv_yes); |
1030 | PUSHs (&PL_sv_yes); |
1022 | PUSHs (fullname); |
1031 | PUSHs (fullname); |
1023 | PUSHs (CxHASARGS (cx) ? sv_2mortal (newRV_inc ((SV *)cx->blk_sub.argarray)) : &PL_sv_undef); |
1032 | PUSHs (CxHASARGS (cx) ? sv_2mortal (newRV_inc ((SV *)cx->blk_sub.argarray)) : &PL_sv_undef); |
1024 | PUTBACK; |
1033 | PUTBACK; |
1025 | cb = hv_fetch ((HV *)SvRV (coro_current), "_trace_sub_cb", sizeof ("_trace_sub_cb") - 1, 0); |
1034 | cb = hv_fetch ((HV *)SvRV (coro_current), "_trace_sub_cb", sizeof ("_trace_sub_cb") - 1, 0); |
1026 | if (cb) call_sv (*cb, G_KEEPERR | G_EVAL | G_VOID | G_DISCARD); |
1035 | if (cb) call_sv (*cb, G_KEEPERR | G_EVAL | G_VOID | G_DISCARD); |
1027 | SPAGAIN; |
1036 | SPAGAIN; |
1028 | FREETMPS; |
1037 | FREETMPS; |
… | |
… | |
1134 | transfer_tail (aTHX); |
1143 | transfer_tail (aTHX); |
1135 | |
1144 | |
1136 | /* somebody or something will hit me for both perl_run and PL_restartop */ |
1145 | /* somebody or something will hit me for both perl_run and PL_restartop */ |
1137 | PL_restartop = PL_op; |
1146 | PL_restartop = PL_op; |
1138 | perl_run (PL_curinterp); |
1147 | perl_run (PL_curinterp); |
|
|
1148 | /* |
|
|
1149 | * Unfortunately, there is no way to get at the return values of the |
|
|
1150 | * coro body here, as perl_run destroys these |
|
|
1151 | */ |
1139 | |
1152 | |
1140 | /* |
1153 | /* |
1141 | * If perl-run returns we assume exit() was being called or the coro |
1154 | * If perl-run returns we assume exit() was being called or the coro |
1142 | * fell off the end, which seems to be the only valid (non-bug) |
1155 | * fell off the end, which seems to be the only valid (non-bug) |
1143 | * reason for perl_run to return. We try to exit by jumping to the |
1156 | * reason for perl_run to return. We try to exit by jumping to the |
… | |
… | |
1435 | |
1448 | |
1436 | coro->slot = 0; |
1449 | coro->slot = 0; |
1437 | } |
1450 | } |
1438 | |
1451 | |
1439 | cctx_destroy (coro->cctx); |
1452 | cctx_destroy (coro->cctx); |
|
|
1453 | SvREFCNT_dec (coro->startcv); |
1440 | SvREFCNT_dec (coro->args); |
1454 | SvREFCNT_dec (coro->args); |
|
|
1455 | SvREFCNT_dec (CORO_THROW); |
1441 | |
1456 | |
1442 | if (coro->next) coro->next->prev = coro->prev; |
1457 | if (coro->next) coro->next->prev = coro->prev; |
1443 | if (coro->prev) coro->prev->next = coro->next; |
1458 | if (coro->prev) coro->prev->next = coro->next; |
1444 | if (coro == coro_first) coro_first = coro->next; |
1459 | if (coro == coro_first) coro_first = coro->next; |
1445 | |
1460 | |
… | |
… | |
2174 | AvARRAY (av)[0] = AvARRAY (av)[1]; |
2189 | AvARRAY (av)[0] = AvARRAY (av)[1]; |
2175 | AvARRAY (av)[1] = count_sv; |
2190 | AvARRAY (av)[1] = count_sv; |
2176 | cb = av_shift (av); |
2191 | cb = av_shift (av); |
2177 | |
2192 | |
2178 | if (SvOBJECT (cb)) |
2193 | if (SvOBJECT (cb)) |
|
|
2194 | { |
2179 | api_ready (aTHX_ cb); |
2195 | api_ready (aTHX_ cb); |
2180 | else |
2196 | --count; |
2181 | croak ("callbacks not yet supported"); |
2197 | } |
|
|
2198 | else if (SvTYPE (cb) == SVt_PVCV) |
|
|
2199 | { |
|
|
2200 | dSP; |
|
|
2201 | PUSHMARK (SP); |
|
|
2202 | XPUSHs (sv_2mortal (newRV_inc ((SV *)av))); |
|
|
2203 | PUTBACK; |
|
|
2204 | call_sv (cb, G_VOID | G_DISCARD | G_EVAL | G_KEEPERR); |
|
|
2205 | } |
2182 | |
2206 | |
2183 | SvREFCNT_dec (cb); |
2207 | SvREFCNT_dec (cb); |
2184 | |
|
|
2185 | --count; |
|
|
2186 | } |
2208 | } |
2187 | } |
2209 | } |
2188 | |
2210 | |
2189 | static void |
2211 | static void |
2190 | coro_semaphore_on_destroy (pTHX_ struct coro *coro) |
2212 | coro_semaphore_on_destroy (pTHX_ struct coro *coro) |
… | |
… | |
2272 | } |
2294 | } |
2273 | |
2295 | |
2274 | static void |
2296 | static void |
2275 | slf_init_semaphore_wait (pTHX_ struct CoroSLF *frame, CV *cv, SV **arg, int items) |
2297 | slf_init_semaphore_wait (pTHX_ struct CoroSLF *frame, CV *cv, SV **arg, int items) |
2276 | { |
2298 | { |
|
|
2299 | if (items >= 2) |
|
|
2300 | { |
|
|
2301 | /* callback form */ |
|
|
2302 | AV *av = (AV *)SvRV (arg [0]); |
|
|
2303 | CV *cb_cv = coro_sv_2cv (arg [1]); |
|
|
2304 | |
|
|
2305 | av_push (av, (SV *)SvREFCNT_inc_NN (cb_cv)); |
|
|
2306 | |
|
|
2307 | if (SvIVX (AvARRAY (av)[0]) > 0) |
|
|
2308 | coro_semaphore_adjust (aTHX_ av, 0); |
|
|
2309 | |
|
|
2310 | frame->prepare = prepare_nop; |
|
|
2311 | frame->check = slf_check_nop; |
|
|
2312 | } |
|
|
2313 | else |
|
|
2314 | { |
2277 | slf_init_semaphore_down_or_wait (aTHX_ frame, cv, arg, items); |
2315 | slf_init_semaphore_down_or_wait (aTHX_ frame, cv, arg, items); |
2278 | frame->check = slf_check_semaphore_wait; |
2316 | frame->check = slf_check_semaphore_wait; |
|
|
2317 | } |
2279 | } |
2318 | } |
2280 | |
2319 | |
2281 | /* signal */ |
2320 | /* signal */ |
2282 | |
2321 | |
2283 | static void |
2322 | static void |
… | |
… | |
2580 | CODE: |
2619 | CODE: |
2581 | { |
2620 | { |
2582 | struct coro *coro; |
2621 | struct coro *coro; |
2583 | MAGIC *mg; |
2622 | MAGIC *mg; |
2584 | HV *hv; |
2623 | HV *hv; |
|
|
2624 | CV *cb; |
2585 | int i; |
2625 | int i; |
|
|
2626 | |
|
|
2627 | if (items > 1) |
|
|
2628 | { |
|
|
2629 | cb = coro_sv_2cv (ST (1)); |
|
|
2630 | |
|
|
2631 | if (CvISXSUB (cb)) |
|
|
2632 | croak ("Coro::State doesn't support XS functions as coroutine start, caught"); |
|
|
2633 | |
|
|
2634 | if (!CvROOT (cb)) |
|
|
2635 | croak ("Coro::State doesn't support autoloaded or undefined functions as coroutine start, caught"); |
|
|
2636 | } |
2586 | |
2637 | |
2587 | Newz (0, coro, 1, struct coro); |
2638 | Newz (0, coro, 1, struct coro); |
2588 | coro->args = newAV (); |
2639 | coro->args = newAV (); |
2589 | coro->flags = CF_NEW; |
2640 | coro->flags = CF_NEW; |
2590 | |
2641 | |
… | |
… | |
2595 | coro->hv = hv = newHV (); |
2646 | coro->hv = hv = newHV (); |
2596 | mg = sv_magicext ((SV *)hv, 0, CORO_MAGIC_type_state, &coro_state_vtbl, (char *)coro, 0); |
2647 | mg = sv_magicext ((SV *)hv, 0, CORO_MAGIC_type_state, &coro_state_vtbl, (char *)coro, 0); |
2597 | mg->mg_flags |= MGf_DUP; |
2648 | mg->mg_flags |= MGf_DUP; |
2598 | RETVAL = sv_bless (newRV_noinc ((SV *)hv), gv_stashpv (klass, 1)); |
2649 | RETVAL = sv_bless (newRV_noinc ((SV *)hv), gv_stashpv (klass, 1)); |
2599 | |
2650 | |
|
|
2651 | if (items > 1) |
|
|
2652 | { |
|
|
2653 | coro->startcv = SvREFCNT_inc_NN (cb); |
|
|
2654 | |
2600 | av_extend (coro->args, items - 1); |
2655 | av_extend (coro->args, items - 1); |
2601 | for (i = 1; i < items; i++) |
2656 | for (i = 2; i < items; i++) |
2602 | av_push (coro->args, newSVsv (ST (i))); |
2657 | av_push (coro->args, newSVsv (ST (i))); |
|
|
2658 | } |
2603 | } |
2659 | } |
2604 | OUTPUT: |
2660 | OUTPUT: |
2605 | RETVAL |
2661 | RETVAL |
2606 | |
2662 | |
2607 | void |
2663 | void |
… | |
… | |
2990 | RETVAL = coro_new_rouse_cb (aTHX); |
3046 | RETVAL = coro_new_rouse_cb (aTHX); |
2991 | OUTPUT: |
3047 | OUTPUT: |
2992 | RETVAL |
3048 | RETVAL |
2993 | |
3049 | |
2994 | void |
3050 | void |
2995 | rouse_wait (SV *cb = 0) |
3051 | rouse_wait (...) |
2996 | PROTOTYPE: ;$ |
3052 | PROTOTYPE: ;$ |
2997 | PPCODE: |
3053 | PPCODE: |
2998 | CORO_EXECUTE_SLF_XS (slf_init_rouse_wait); |
3054 | CORO_EXECUTE_SLF_XS (slf_init_rouse_wait); |
2999 | |
3055 | |
3000 | |
3056 | |
… | |
… | |
3037 | adjust = 1 |
3093 | adjust = 1 |
3038 | CODE: |
3094 | CODE: |
3039 | coro_semaphore_adjust (aTHX_ (AV *)SvRV (self), ix ? adjust : 1); |
3095 | coro_semaphore_adjust (aTHX_ (AV *)SvRV (self), ix ? adjust : 1); |
3040 | |
3096 | |
3041 | void |
3097 | void |
3042 | down (SV *self) |
3098 | down (...) |
3043 | CODE: |
3099 | CODE: |
3044 | CORO_EXECUTE_SLF_XS (slf_init_semaphore_down); |
3100 | CORO_EXECUTE_SLF_XS (slf_init_semaphore_down); |
3045 | |
3101 | |
3046 | void |
3102 | void |
3047 | wait (SV *self) |
3103 | wait (...) |
3048 | CODE: |
3104 | CODE: |
3049 | CORO_EXECUTE_SLF_XS (slf_init_semaphore_wait); |
3105 | CORO_EXECUTE_SLF_XS (slf_init_semaphore_wait); |
3050 | |
3106 | |
3051 | void |
3107 | void |
3052 | try (SV *self) |
3108 | try (SV *self) |
… | |
… | |
3095 | ); |
3151 | ); |
3096 | OUTPUT: |
3152 | OUTPUT: |
3097 | RETVAL |
3153 | RETVAL |
3098 | |
3154 | |
3099 | void |
3155 | void |
3100 | wait (SV *self) |
3156 | wait (...) |
3101 | CODE: |
3157 | CODE: |
3102 | CORO_EXECUTE_SLF_XS (slf_init_signal_wait); |
3158 | CORO_EXECUTE_SLF_XS (slf_init_signal_wait); |
3103 | |
3159 | |
3104 | void |
3160 | void |
3105 | broadcast (SV *self) |
3161 | broadcast (SV *self) |
… | |
… | |
3162 | |
3218 | |
3163 | void |
3219 | void |
3164 | _register (char *target, char *proto, SV *req) |
3220 | _register (char *target, char *proto, SV *req) |
3165 | CODE: |
3221 | CODE: |
3166 | { |
3222 | { |
3167 | HV *st; |
|
|
3168 | GV *gvp; |
|
|
3169 | CV *req_cv = sv_2cv (req, &st, &gvp, 0); |
3223 | CV *req_cv = coro_sv_2cv (req); |
3170 | /* newXSproto doesn't return the CV on 5.8 */ |
3224 | /* newXSproto doesn't return the CV on 5.8 */ |
3171 | CV *slf_cv = newXS (target, coro_aio_req_xs, __FILE__); |
3225 | CV *slf_cv = newXS (target, coro_aio_req_xs, __FILE__); |
3172 | sv_setpv ((SV *)slf_cv, proto); |
3226 | sv_setpv ((SV *)slf_cv, proto); |
3173 | sv_magicext ((SV *)slf_cv, (SV *)req_cv, CORO_MAGIC_type_aio, 0, 0, 0); |
3227 | sv_magicext ((SV *)slf_cv, (SV *)req_cv, CORO_MAGIC_type_aio, 0, 0, 0); |
3174 | } |
3228 | } |