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.306 by root, Wed Nov 19 11:11:10 2008 UTC vs.
Revision 1.310 by root, Wed Nov 19 16:01:32 2008 UTC

… …
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
… …
288 289
289/* for Coro.pm */ 290/* for Coro.pm */
290static SV *coro_current; 291static SV *coro_current;
291static SV *coro_readyhook; 292static SV *coro_readyhook;
292static AV *coro_ready [PRIO_MAX - PRIO_MIN + 1]; 293static AV *coro_ready [PRIO_MAX - PRIO_MIN + 1];
294static CV *cv_coro_run;
293static struct coro *coro_first; 295static struct coro *coro_first;
294#define coro_nready coroapi.nready 296#define coro_nready coroapi.nready
295 297
296/** lowlevel stuff **********************************************************/ 298/** lowlevel stuff **********************************************************/
297 299
… …
321#if PERL_VERSION_ATLEAST (5,10,0) 323#if PERL_VERSION_ATLEAST (5,10,0)
322 /* silence stupid and wrong 5.10 warning that I am unable to switch off */ 324 /* silence stupid and wrong 5.10 warning that I am unable to switch off */
323 get_hv (name, create); 325 get_hv (name, create);
324#endif 326#endif
325 return get_hv (name, create); 327 return get_hv (name, create);
328}
329
330/* may croak */
331INLINE CV *
332coro_sv_2cv (SV *sv)
333{
334 HV *st;
335 GV *gvp;
336 return sv_2cv (sv, &st, &gvp, 0);
326} 337}
327 338
328static AV * 339static AV *
329coro_clone_padlist (pTHX_ CV *cv) 340coro_clone_padlist (pTHX_ CV *cv)
330{ 341{
… …
861 dSP; 872 dSP;
862 UNOP myop; 873 UNOP myop;
863 874
864 Zero (&myop, 1, UNOP); 875 Zero (&myop, 1, UNOP);
865 myop.op_next = Nullop; 876 myop.op_next = Nullop;
877 myop.op_type = OP_ENTERSUB;
866 myop.op_flags = OPf_WANT_VOID; 878 myop.op_flags = OPf_WANT_VOID;
867 879
868 PUSHMARK (SP); 880 PUSHMARK (SP);
869 XPUSHs (sv_2mortal (av_shift (GvAV (PL_defgv)))); 881 PUSHs ((SV *)coro->startcv);
870 PUTBACK; 882 PUTBACK;
871 PL_op = (OP *)&myop; 883 PL_op = (OP *)&myop;
872 PL_op = PL_ppaddr[OP_ENTERSUB](aTHX); 884 PL_op = PL_ppaddr[OP_ENTERSUB](aTHX);
873 SPAGAIN;
874 } 885 }
875 886
876 /* this newly created coroutine might be run on an existing cctx which most 887 /* 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. 888 * likely was suspended in pp_slf, so we have to emulate entering pp_slf here.
878 */ 889 */
… …
881 892
882 /* and we have to provide the pp_slf op in any case, so pp_slf can skip it */ 893 /* 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; 894 coro_setup_op.op_next = PL_op;
884 coro_setup_op.op_type = OP_CUSTOM; 895 coro_setup_op.op_type = OP_CUSTOM;
885 coro_setup_op.op_ppaddr = pp_slf; 896 coro_setup_op.op_ppaddr = pp_slf;
886 /* no flags required, as an init function won't be called */ 897 /* no flags etc. required, as an init function won't be called */
887 898
888 PL_op = (OP *)&coro_setup_op; 899 PL_op = (OP *)&coro_setup_op;
889 900
890 /* copy throw, in case it was set before coro_setup */ 901 /* copy throw, in case it was set before coro_setup */
891 CORO_THROW = coro->except; 902 CORO_THROW = coro->except;
… …
919 SvREFCNT_dec (GvSV (irsgv)); 930 SvREFCNT_dec (GvSV (irsgv));
920 931
921 SvREFCNT_dec (PL_diehook); 932 SvREFCNT_dec (PL_diehook);
922 SvREFCNT_dec (PL_warnhook); 933 SvREFCNT_dec (PL_warnhook);
923 934
924 SvREFCNT_dec (CORO_THROW);
925 SvREFCNT_dec (coro->saved_deffh); 935 SvREFCNT_dec (coro->saved_deffh);
926 SvREFCNT_dec (coro->rouse_cb); 936 SvREFCNT_dec (coro->rouse_cb);
927 937
928 coro_destruct_stacks (aTHX); 938 coro_destruct_stacks (aTHX);
929} 939}
… …
1018 SAVETMPS; 1028 SAVETMPS;
1019 EXTEND (SP, 3); 1029 EXTEND (SP, 3);
1020 PUSHMARK (SP); 1030 PUSHMARK (SP);
1021 PUSHs (&PL_sv_yes); 1031 PUSHs (&PL_sv_yes);
1022 PUSHs (fullname); 1032 PUSHs (fullname);
1023 PUSHs (CxHASARGS (cx) ? sv_2mortal (newRV_inc ((SV *)cx->blk_sub.argarray)) : &PL_sv_undef); 1033 PUSHs (CxHASARGS (cx) ? sv_2mortal (newRV_inc ((SV *)cx->blk_sub.argarray)) : &PL_sv_undef);
1024 PUTBACK; 1034 PUTBACK;
1025 cb = hv_fetch ((HV *)SvRV (coro_current), "_trace_sub_cb", sizeof ("_trace_sub_cb") - 1, 0); 1035 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); 1036 if (cb) call_sv (*cb, G_KEEPERR | G_EVAL | G_VOID | G_DISCARD);
1027 SPAGAIN; 1037 SPAGAIN;
1028 FREETMPS; 1038 FREETMPS;
… …
1134 transfer_tail (aTHX); 1144 transfer_tail (aTHX);
1135 1145
1136 /* somebody or something will hit me for both perl_run and PL_restartop */ 1146 /* somebody or something will hit me for both perl_run and PL_restartop */
1137 PL_restartop = PL_op; 1147 PL_restartop = PL_op;
1138 perl_run (PL_curinterp); 1148 perl_run (PL_curinterp);
1149 /*
1150 * Unfortunately, there is no way to get at the return values of the
1151 * coro body here, as perl_run destroys these
1152 */
1139 1153
1140 /* 1154 /*
1141 * If perl-run returns we assume exit() was being called or the coro 1155 * 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) 1156 * 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 1157 * reason for perl_run to return. We try to exit by jumping to the
… …
1435 1449
1436 coro->slot = 0; 1450 coro->slot = 0;
1437 } 1451 }
1438 1452
1439 cctx_destroy (coro->cctx); 1453 cctx_destroy (coro->cctx);
1454 SvREFCNT_dec (coro->startcv);
1440 SvREFCNT_dec (coro->args); 1455 SvREFCNT_dec (coro->args);
1456 SvREFCNT_dec (CORO_THROW);
1441 1457
1442 if (coro->next) coro->next->prev = coro->prev; 1458 if (coro->next) coro->next->prev = coro->prev;
1443 if (coro->prev) coro->prev->next = coro->next; 1459 if (coro->prev) coro->prev->next = coro->next;
1444 if (coro == coro_first) coro_first = coro->next; 1460 if (coro == coro_first) coro_first = coro->next;
1445 1461
… …
2283{ 2299{
2284 if (items >= 2) 2300 if (items >= 2)
2285 { 2301 {
2286 /* callback form */ 2302 /* callback form */
2287 AV *av = (AV *)SvRV (arg [0]); 2303 AV *av = (AV *)SvRV (arg [0]);
2288 HV *st;
2289 GV *gvp;
2290 CV *cb_cv = sv_2cv (arg [1], &st, &gvp, 0); 2304 CV *cb_cv = coro_sv_2cv (arg [1]);
2291 2305
2292 av_push (av, (SV *)SvREFCNT_inc_NN (cb_cv)); 2306 av_push (av, (SV *)SvREFCNT_inc_NN (cb_cv));
2293 2307
2294 if (SvIVX (AvARRAY (av)[0]) > 0) 2308 if (SvIVX (AvARRAY (av)[0]) > 0)
2295 coro_semaphore_adjust (aTHX_ av, 0); 2309 coro_semaphore_adjust (aTHX_ av, 0);
… …
2601 assert (("PRIO_NORMAL must be 0", !PRIO_NORMAL)); 2615 assert (("PRIO_NORMAL must be 0", !PRIO_NORMAL));
2602} 2616}
2603 2617
2604SV * 2618SV *
2605new (char *klass, ...) 2619new (char *klass, ...)
2620 ALIAS:
2621 Coro::new = 1
2606 CODE: 2622 CODE:
2607{ 2623{
2608 struct coro *coro; 2624 struct coro *coro;
2609 MAGIC *mg; 2625 MAGIC *mg;
2610 HV *hv; 2626 HV *hv;
2627 CV *cb;
2611 int i; 2628 int i;
2629
2630 if (items > 1)
2631 {
2632 cb = coro_sv_2cv (ST (1));
2633
2634 if (!ix)
2635 {
2636 if (CvISXSUB (cb))
2637 croak ("Coro::State doesn't support XS functions as coroutine start, caught");
2638
2639 if (!CvROOT (cb))
2640 croak ("Coro::State doesn't support autoloaded or undefined functions as coroutine start, caught");
2641 }
2642 }
2612 2643
2613 Newz (0, coro, 1, struct coro); 2644 Newz (0, coro, 1, struct coro);
2614 coro->args = newAV (); 2645 coro->args = newAV ();
2615 coro->flags = CF_NEW; 2646 coro->flags = CF_NEW;
2616 2647
… …
2621 coro->hv = hv = newHV (); 2652 coro->hv = hv = newHV ();
2622 mg = sv_magicext ((SV *)hv, 0, CORO_MAGIC_type_state, &coro_state_vtbl, (char *)coro, 0); 2653 mg = sv_magicext ((SV *)hv, 0, CORO_MAGIC_type_state, &coro_state_vtbl, (char *)coro, 0);
2623 mg->mg_flags |= MGf_DUP; 2654 mg->mg_flags |= MGf_DUP;
2624 RETVAL = sv_bless (newRV_noinc ((SV *)hv), gv_stashpv (klass, 1)); 2655 RETVAL = sv_bless (newRV_noinc ((SV *)hv), gv_stashpv (klass, 1));
2625 2656
2657 if (items > 1)
2658 {
2626 av_extend (coro->args, items - 1); 2659 av_extend (coro->args, items - 1 + ix);
2660
2661 if (ix)
2662 {
2663 av_push (coro->args, SvREFCNT_inc_NN ((SV *)cb));
2664 cb = cv_coro_run;
2665 }
2666
2667 coro->startcv = (CV *)SvREFCNT_inc_NN ((SV *)cb);
2668
2627 for (i = 1; i < items; i++) 2669 for (i = 2; i < items; i++)
2628 av_push (coro->args, newSVsv (ST (i))); 2670 av_push (coro->args, newSVsv (ST (i)));
2671 }
2629} 2672}
2630 OUTPUT: 2673 OUTPUT:
2631 RETVAL 2674 RETVAL
2632 2675
2633void 2676void
… …
2834 int i; 2877 int i;
2835 2878
2836 av_async_pool = coro_get_av (aTHX_ "Coro::async_pool", TRUE); 2879 av_async_pool = coro_get_av (aTHX_ "Coro::async_pool", TRUE);
2837 sv_pool_rss = coro_get_sv (aTHX_ "Coro::POOL_RSS" , TRUE); 2880 sv_pool_rss = coro_get_sv (aTHX_ "Coro::POOL_RSS" , TRUE);
2838 sv_pool_size = coro_get_sv (aTHX_ "Coro::POOL_SIZE" , TRUE); 2881 sv_pool_size = coro_get_sv (aTHX_ "Coro::POOL_SIZE" , TRUE);
2839 2882 cv_coro_run = get_cv (aTHX_ "Coro::_terminate", GV_ADD);
2840 coro_current = coro_get_sv (aTHX_ "Coro::current", FALSE); 2883 coro_current = coro_get_sv (aTHX_ "Coro::current" , FALSE);
2841 SvREADONLY_on (coro_current); 2884 SvREADONLY_on (coro_current);
2842 2885
2843 coro_stash = gv_stashpv ("Coro", TRUE); 2886 coro_stash = gv_stashpv ("Coro", TRUE);
2844 2887
2845 newCONSTSUB (coro_stash, "PRIO_MAX", newSViv (PRIO_MAX)); 2888 newCONSTSUB (coro_stash, "PRIO_MAX", newSViv (PRIO_MAX));
… …
3188 3231
3189void 3232void
3190_register (char *target, char *proto, SV *req) 3233_register (char *target, char *proto, SV *req)
3191 CODE: 3234 CODE:
3192{ 3235{
3193 HV *st;
3194 GV *gvp;
3195 CV *req_cv = sv_2cv (req, &st, &gvp, 0); 3236 CV *req_cv = coro_sv_2cv (req);
3196 /* newXSproto doesn't return the CV on 5.8 */ 3237 /* newXSproto doesn't return the CV on 5.8 */
3197 CV *slf_cv = newXS (target, coro_aio_req_xs, __FILE__); 3238 CV *slf_cv = newXS (target, coro_aio_req_xs, __FILE__);
3198 sv_setpv ((SV *)slf_cv, proto); 3239 sv_setpv ((SV *)slf_cv, proto);
3199 sv_magicext ((SV *)slf_cv, (SV *)req_cv, CORO_MAGIC_type_aio, 0, 0, 0); 3240 sv_magicext ((SV *)slf_cv, (SV *)req_cv, CORO_MAGIC_type_aio, 0, 0, 0);
3200} 3241}

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines