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.303 by root, Wed Nov 19 05:52:42 2008 UTC vs.
Revision 1.308 by root, Wed Nov 19 15:09:57 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
… …
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 */
330INLINE CV *
331coro_sv_2cv (SV *sv)
332{
333 HV *st;
334 GV *gvp;
335 return sv_2cv (sv, &st, &gvp, 0);
326} 336}
327 337
328static AV * 338static AV *
329coro_clone_padlist (pTHX_ CV *cv) 339coro_clone_padlist (pTHX_ CV *cv)
330{ 340{
… …
449 else 459 else
450 { 460 {
451#if CORO_PREFER_PERL_FUNCTIONS 461#if CORO_PREFER_PERL_FUNCTIONS
452 /* this is probably cleaner? but also slower! */ 462 /* this is probably cleaner? but also slower! */
453 /* in practise, it seems to be less stable */ 463 /* in practise, it seems to be less stable */
454 CV *cp = Perl_cv_clone (cv); 464 CV *cp = Perl_cv_clone (aTHX_ cv);
455 CvPADLIST (cv) = CvPADLIST (cp); 465 CvPADLIST (cv) = CvPADLIST (cp);
456 CvPADLIST (cp) = 0; 466 CvPADLIST (cp) = 0;
457 SvREFCNT_dec (cp); 467 SvREFCNT_dec (cp);
458#else 468#else
459 CvPADLIST (cv) = coro_clone_padlist (aTHX_ cv); 469 CvPADLIST (cv) = coro_clone_padlist (aTHX_ cv);
… …
603 * of perl.c:init_stacks, except that it uses less memory 613 * of perl.c:init_stacks, except that it uses less memory
604 * on the (sometimes correct) assumption that coroutines do 614 * on the (sometimes correct) assumption that coroutines do
605 * not usually need a lot of stackspace. 615 * not usually need a lot of stackspace.
606 */ 616 */
607#if CORO_PREFER_PERL_FUNCTIONS 617#if CORO_PREFER_PERL_FUNCTIONS
608# define coro_init_stacks init_stacks 618# define coro_init_stacks(thx) init_stacks ()
609#else 619#else
610static void 620static void
611coro_init_stacks (pTHX) 621coro_init_stacks (pTHX)
612{ 622{
613 PL_curstackinfo = new_stackinfo(32, 8); 623 PL_curstackinfo = new_stackinfo(32, 8);
… …
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
… …
2143 SV **ary; 2158 SV **ary;
2144 2159
2145 /* unfortunately, building manually saves memory */ 2160 /* unfortunately, building manually saves memory */
2146 Newx (ary, 2, SV *); 2161 Newx (ary, 2, SV *);
2147 AvALLOC (av) = ary; 2162 AvALLOC (av) = ary;
2148 AvARRAY (av) = ary; 2163 /*AvARRAY (av) = ary;*/
2164 SvPVX ((SV *)av) = (char *)ary; /* 5.8.8 needs this syntax instead of AvARRAY = ary */
2149 AvMAX (av) = 1; 2165 AvMAX (av) = 1;
2150 AvFILLp (av) = 0; 2166 AvFILLp (av) = 0;
2151 ary [0] = newSViv (count); 2167 ary [0] = newSViv (count);
2152 2168
2153 return newRV_noinc ((SV *)av); 2169 return newRV_noinc ((SV *)av);
… …
2173 AvARRAY (av)[0] = AvARRAY (av)[1]; 2189 AvARRAY (av)[0] = AvARRAY (av)[1];
2174 AvARRAY (av)[1] = count_sv; 2190 AvARRAY (av)[1] = count_sv;
2175 cb = av_shift (av); 2191 cb = av_shift (av);
2176 2192
2177 if (SvOBJECT (cb)) 2193 if (SvOBJECT (cb))
2194 {
2178 api_ready (aTHX_ cb); 2195 api_ready (aTHX_ cb);
2179 else 2196 --count;
2180 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 }
2181 2206
2182 SvREFCNT_dec (cb); 2207 SvREFCNT_dec (cb);
2183
2184 --count;
2185 } 2208 }
2186} 2209}
2187 2210
2188static void 2211static void
2189coro_semaphore_on_destroy (pTHX_ struct coro *coro) 2212coro_semaphore_on_destroy (pTHX_ struct coro *coro)
… …
2271} 2294}
2272 2295
2273static void 2296static void
2274slf_init_semaphore_wait (pTHX_ struct CoroSLF *frame, CV *cv, SV **arg, int items) 2297slf_init_semaphore_wait (pTHX_ struct CoroSLF *frame, CV *cv, SV **arg, int items)
2275{ 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 {
2276 slf_init_semaphore_down_or_wait (aTHX_ frame, cv, arg, items); 2315 slf_init_semaphore_down_or_wait (aTHX_ frame, cv, arg, items);
2277 frame->check = slf_check_semaphore_wait; 2316 frame->check = slf_check_semaphore_wait;
2317 }
2278} 2318}
2279 2319
2280/* signal */ 2320/* signal */
2281 2321
2282static void 2322static void
… …
2579 CODE: 2619 CODE:
2580{ 2620{
2581 struct coro *coro; 2621 struct coro *coro;
2582 MAGIC *mg; 2622 MAGIC *mg;
2583 HV *hv; 2623 HV *hv;
2624 CV *cb;
2584 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 }
2585 2637
2586 Newz (0, coro, 1, struct coro); 2638 Newz (0, coro, 1, struct coro);
2587 coro->args = newAV (); 2639 coro->args = newAV ();
2588 coro->flags = CF_NEW; 2640 coro->flags = CF_NEW;
2589 2641
… …
2594 coro->hv = hv = newHV (); 2646 coro->hv = hv = newHV ();
2595 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);
2596 mg->mg_flags |= MGf_DUP; 2648 mg->mg_flags |= MGf_DUP;
2597 RETVAL = sv_bless (newRV_noinc ((SV *)hv), gv_stashpv (klass, 1)); 2649 RETVAL = sv_bless (newRV_noinc ((SV *)hv), gv_stashpv (klass, 1));
2598 2650
2651 if (items > 1)
2652 {
2653 coro->startcv = SvREFCNT_inc_NN (cb);
2654
2599 av_extend (coro->args, items - 1); 2655 av_extend (coro->args, items - 1);
2600 for (i = 1; i < items; i++) 2656 for (i = 2; i < items; i++)
2601 av_push (coro->args, newSVsv (ST (i))); 2657 av_push (coro->args, newSVsv (ST (i)));
2658 }
2602} 2659}
2603 OUTPUT: 2660 OUTPUT:
2604 RETVAL 2661 RETVAL
2605 2662
2606void 2663void
… …
2989 RETVAL = coro_new_rouse_cb (aTHX); 3046 RETVAL = coro_new_rouse_cb (aTHX);
2990 OUTPUT: 3047 OUTPUT:
2991 RETVAL 3048 RETVAL
2992 3049
2993void 3050void
2994rouse_wait (SV *cb = 0) 3051rouse_wait (...)
2995 PROTOTYPE: ;$ 3052 PROTOTYPE: ;$
2996 PPCODE: 3053 PPCODE:
2997 CORO_EXECUTE_SLF_XS (slf_init_rouse_wait); 3054 CORO_EXECUTE_SLF_XS (slf_init_rouse_wait);
2998 3055
2999 3056
… …
3036 adjust = 1 3093 adjust = 1
3037 CODE: 3094 CODE:
3038 coro_semaphore_adjust (aTHX_ (AV *)SvRV (self), ix ? adjust : 1); 3095 coro_semaphore_adjust (aTHX_ (AV *)SvRV (self), ix ? adjust : 1);
3039 3096
3040void 3097void
3041down (SV *self) 3098down (...)
3042 CODE: 3099 CODE:
3043 CORO_EXECUTE_SLF_XS (slf_init_semaphore_down); 3100 CORO_EXECUTE_SLF_XS (slf_init_semaphore_down);
3044 3101
3045void 3102void
3046wait (SV *self) 3103wait (...)
3047 CODE: 3104 CODE:
3048 CORO_EXECUTE_SLF_XS (slf_init_semaphore_wait); 3105 CORO_EXECUTE_SLF_XS (slf_init_semaphore_wait);
3049 3106
3050void 3107void
3051try (SV *self) 3108try (SV *self)
… …
3094 ); 3151 );
3095 OUTPUT: 3152 OUTPUT:
3096 RETVAL 3153 RETVAL
3097 3154
3098void 3155void
3099wait (SV *self) 3156wait (...)
3100 CODE: 3157 CODE:
3101 CORO_EXECUTE_SLF_XS (slf_init_signal_wait); 3158 CORO_EXECUTE_SLF_XS (slf_init_signal_wait);
3102 3159
3103void 3160void
3104broadcast (SV *self) 3161broadcast (SV *self)
… …
3161 3218
3162void 3219void
3163_register (char *target, char *proto, SV *req) 3220_register (char *target, char *proto, SV *req)
3164 CODE: 3221 CODE:
3165{ 3222{
3166 HV *st;
3167 GV *gvp;
3168 CV *req_cv = sv_2cv (req, &st, &gvp, 0); 3223 CV *req_cv = coro_sv_2cv (req);
3169 /* newXSproto doesn't return the CV on 5.8 */ 3224 /* newXSproto doesn't return the CV on 5.8 */
3170 CV *slf_cv = newXS (target, coro_aio_req_xs, __FILE__); 3225 CV *slf_cv = newXS (target, coro_aio_req_xs, __FILE__);
3171 sv_setpv ((SV *)slf_cv, proto); 3226 sv_setpv ((SV *)slf_cv, proto);
3172 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);
3173} 3228}

Diff Legend

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