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.302 by root, Wed Nov 19 04:48:24 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{
… …
449 else 460 else
450 { 461 {
451#if CORO_PREFER_PERL_FUNCTIONS 462#if CORO_PREFER_PERL_FUNCTIONS
452 /* this is probably cleaner? but also slower! */ 463 /* this is probably cleaner? but also slower! */
453 /* in practise, it seems to be less stable */ 464 /* in practise, it seems to be less stable */
454 CV *cp = Perl_cv_clone (cv); 465 CV *cp = Perl_cv_clone (aTHX_ cv);
455 CvPADLIST (cv) = CvPADLIST (cp); 466 CvPADLIST (cv) = CvPADLIST (cp);
456 CvPADLIST (cp) = 0; 467 CvPADLIST (cp) = 0;
457 SvREFCNT_dec (cp); 468 SvREFCNT_dec (cp);
458#else 469#else
459 CvPADLIST (cv) = coro_clone_padlist (aTHX_ cv); 470 CvPADLIST (cv) = coro_clone_padlist (aTHX_ cv);
… …
603 * of perl.c:init_stacks, except that it uses less memory 614 * of perl.c:init_stacks, except that it uses less memory
604 * on the (sometimes correct) assumption that coroutines do 615 * on the (sometimes correct) assumption that coroutines do
605 * not usually need a lot of stackspace. 616 * not usually need a lot of stackspace.
606 */ 617 */
607#if CORO_PREFER_PERL_FUNCTIONS 618#if CORO_PREFER_PERL_FUNCTIONS
608# define coro_init_stacks init_stacks 619# define coro_init_stacks(thx) init_stacks ()
609#else 620#else
610static void 621static void
611coro_init_stacks (pTHX) 622coro_init_stacks (pTHX)
612{ 623{
613 PL_curstackinfo = new_stackinfo(32, 8); 624 PL_curstackinfo = new_stackinfo(32, 8);
… …
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
… …
1752 1768
1753 SvRV_set (data, (SV *)av); 1769 SvRV_set (data, (SV *)av);
1754 api_ready (aTHX_ coro); 1770 api_ready (aTHX_ coro);
1755 SvREFCNT_dec (coro); 1771 SvREFCNT_dec (coro);
1756 1772
1773 /* better take a full copy of the arguments */
1757 while (items--) 1774 while (items--)
1758 av_store (av, items, SvREFCNT_inc_NN (ST (items))); 1775 av_store (av, items, newSVsv (ST (items)));
1759 } 1776 }
1760 1777
1761 XSRETURN_EMPTY; 1778 XSRETURN_EMPTY;
1762} 1779}
1763 1780
… …
1778 AV *av = (AV *)SvRV (data); 1795 AV *av = (AV *)SvRV (data);
1779 int i; 1796 int i;
1780 1797
1781 EXTEND (SP, AvFILLp (av) + 1); 1798 EXTEND (SP, AvFILLp (av) + 1);
1782 for (i = 0; i <= AvFILLp (av); ++i) 1799 for (i = 0; i <= AvFILLp (av); ++i)
1783 PUSHs (AvARRAY (av)[i]); 1800 PUSHs (sv_2mortal (AvARRAY (av)[i]));
1801
1802 /* we have stolen the elements, so ste length to zero and free */
1803 AvFILLp (av) = -1;
1804 av_undef (av);
1784 1805
1785 PUTBACK; 1806 PUTBACK;
1786 } 1807 }
1787 1808
1788 return 0; 1809 return 0;
… …
1828 struct coro *coro = SvSTATE_hv (hv); 1849 struct coro *coro = SvSTATE_hv (hv);
1829 SV *data = newRV_inc ((SV *)hv); 1850 SV *data = newRV_inc ((SV *)hv);
1830 SV *cb = gensub (aTHX_ coro_rouse_callback, (void *)data); 1851 SV *cb = gensub (aTHX_ coro_rouse_callback, (void *)data);
1831 1852
1832 sv_magicext (SvRV (cb), data, CORO_MAGIC_type_rouse, 0, 0, 0); 1853 sv_magicext (SvRV (cb), data, CORO_MAGIC_type_rouse, 0, 0, 0);
1854 SvREFCNT_dec (data); /* magicext increases the refcount */
1833 1855
1834 SvREFCNT_dec (coro->rouse_cb); 1856 SvREFCNT_dec (coro->rouse_cb);
1835 coro->rouse_cb = SvREFCNT_inc_NN (cb); 1857 coro->rouse_cb = SvREFCNT_inc_NN (cb);
1836 1858
1837 return cb; 1859 return cb;
… …
2137 SV **ary; 2159 SV **ary;
2138 2160
2139 /* unfortunately, building manually saves memory */ 2161 /* unfortunately, building manually saves memory */
2140 Newx (ary, 2, SV *); 2162 Newx (ary, 2, SV *);
2141 AvALLOC (av) = ary; 2163 AvALLOC (av) = ary;
2142 AvARRAY (av) = ary; 2164 /*AvARRAY (av) = ary;*/
2165 SvPVX ((SV *)av) = (char *)ary; /* 5.8.8 needs this syntax instead of AvARRAY = ary */
2143 AvMAX (av) = 1; 2166 AvMAX (av) = 1;
2144 AvFILLp (av) = 0; 2167 AvFILLp (av) = 0;
2145 ary [0] = newSViv (count); 2168 ary [0] = newSViv (count);
2146 2169
2147 return newRV_noinc ((SV *)av); 2170 return newRV_noinc ((SV *)av);
… …
2167 AvARRAY (av)[0] = AvARRAY (av)[1]; 2190 AvARRAY (av)[0] = AvARRAY (av)[1];
2168 AvARRAY (av)[1] = count_sv; 2191 AvARRAY (av)[1] = count_sv;
2169 cb = av_shift (av); 2192 cb = av_shift (av);
2170 2193
2171 if (SvOBJECT (cb)) 2194 if (SvOBJECT (cb))
2195 {
2172 api_ready (aTHX_ cb); 2196 api_ready (aTHX_ cb);
2173 else 2197 --count;
2174 croak ("callbacks not yet supported"); 2198 }
2199 else if (SvTYPE (cb) == SVt_PVCV)
2200 {
2201 dSP;
2202 PUSHMARK (SP);
2203 XPUSHs (sv_2mortal (newRV_inc ((SV *)av)));
2204 PUTBACK;
2205 call_sv (cb, G_VOID | G_DISCARD | G_EVAL | G_KEEPERR);
2206 }
2175 2207
2176 SvREFCNT_dec (cb); 2208 SvREFCNT_dec (cb);
2177
2178 --count;
2179 } 2209 }
2180} 2210}
2181 2211
2182static void 2212static void
2183coro_semaphore_on_destroy (pTHX_ struct coro *coro) 2213coro_semaphore_on_destroy (pTHX_ struct coro *coro)
… …
2265} 2295}
2266 2296
2267static void 2297static void
2268slf_init_semaphore_wait (pTHX_ struct CoroSLF *frame, CV *cv, SV **arg, int items) 2298slf_init_semaphore_wait (pTHX_ struct CoroSLF *frame, CV *cv, SV **arg, int items)
2269{ 2299{
2300 if (items >= 2)
2301 {
2302 /* callback form */
2303 AV *av = (AV *)SvRV (arg [0]);
2304 CV *cb_cv = coro_sv_2cv (arg [1]);
2305
2306 av_push (av, (SV *)SvREFCNT_inc_NN (cb_cv));
2307
2308 if (SvIVX (AvARRAY (av)[0]) > 0)
2309 coro_semaphore_adjust (aTHX_ av, 0);
2310
2311 frame->prepare = prepare_nop;
2312 frame->check = slf_check_nop;
2313 }
2314 else
2315 {
2270 slf_init_semaphore_down_or_wait (aTHX_ frame, cv, arg, items); 2316 slf_init_semaphore_down_or_wait (aTHX_ frame, cv, arg, items);
2271 frame->check = slf_check_semaphore_wait; 2317 frame->check = slf_check_semaphore_wait;
2318 }
2272} 2319}
2273 2320
2274/* signal */ 2321/* signal */
2275 2322
2276static void 2323static void
… …
2568 assert (("PRIO_NORMAL must be 0", !PRIO_NORMAL)); 2615 assert (("PRIO_NORMAL must be 0", !PRIO_NORMAL));
2569} 2616}
2570 2617
2571SV * 2618SV *
2572new (char *klass, ...) 2619new (char *klass, ...)
2620 ALIAS:
2621 Coro::new = 1
2573 CODE: 2622 CODE:
2574{ 2623{
2575 struct coro *coro; 2624 struct coro *coro;
2576 MAGIC *mg; 2625 MAGIC *mg;
2577 HV *hv; 2626 HV *hv;
2627 CV *cb;
2578 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 }
2579 2643
2580 Newz (0, coro, 1, struct coro); 2644 Newz (0, coro, 1, struct coro);
2581 coro->args = newAV (); 2645 coro->args = newAV ();
2582 coro->flags = CF_NEW; 2646 coro->flags = CF_NEW;
2583 2647
… …
2588 coro->hv = hv = newHV (); 2652 coro->hv = hv = newHV ();
2589 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);
2590 mg->mg_flags |= MGf_DUP; 2654 mg->mg_flags |= MGf_DUP;
2591 RETVAL = sv_bless (newRV_noinc ((SV *)hv), gv_stashpv (klass, 1)); 2655 RETVAL = sv_bless (newRV_noinc ((SV *)hv), gv_stashpv (klass, 1));
2592 2656
2657 if (items > 1)
2658 {
2593 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
2594 for (i = 1; i < items; i++) 2669 for (i = 2; i < items; i++)
2595 av_push (coro->args, newSVsv (ST (i))); 2670 av_push (coro->args, newSVsv (ST (i)));
2671 }
2596} 2672}
2597 OUTPUT: 2673 OUTPUT:
2598 RETVAL 2674 RETVAL
2599 2675
2600void 2676void
… …
2801 int i; 2877 int i;
2802 2878
2803 av_async_pool = coro_get_av (aTHX_ "Coro::async_pool", TRUE); 2879 av_async_pool = coro_get_av (aTHX_ "Coro::async_pool", TRUE);
2804 sv_pool_rss = coro_get_sv (aTHX_ "Coro::POOL_RSS" , TRUE); 2880 sv_pool_rss = coro_get_sv (aTHX_ "Coro::POOL_RSS" , TRUE);
2805 sv_pool_size = coro_get_sv (aTHX_ "Coro::POOL_SIZE" , TRUE); 2881 sv_pool_size = coro_get_sv (aTHX_ "Coro::POOL_SIZE" , TRUE);
2806 2882 cv_coro_run = get_cv (aTHX_ "Coro::_terminate", GV_ADD);
2807 coro_current = coro_get_sv (aTHX_ "Coro::current", FALSE); 2883 coro_current = coro_get_sv (aTHX_ "Coro::current" , FALSE);
2808 SvREADONLY_on (coro_current); 2884 SvREADONLY_on (coro_current);
2809 2885
2810 coro_stash = gv_stashpv ("Coro", TRUE); 2886 coro_stash = gv_stashpv ("Coro", TRUE);
2811 2887
2812 newCONSTSUB (coro_stash, "PRIO_MAX", newSViv (PRIO_MAX)); 2888 newCONSTSUB (coro_stash, "PRIO_MAX", newSViv (PRIO_MAX));
… …
2983 RETVAL = coro_new_rouse_cb (aTHX); 3059 RETVAL = coro_new_rouse_cb (aTHX);
2984 OUTPUT: 3060 OUTPUT:
2985 RETVAL 3061 RETVAL
2986 3062
2987void 3063void
2988rouse_wait (SV *cb = 0) 3064rouse_wait (...)
2989 PROTOTYPE: ;$ 3065 PROTOTYPE: ;$
2990 PPCODE: 3066 PPCODE:
2991 CORO_EXECUTE_SLF_XS (slf_init_rouse_wait); 3067 CORO_EXECUTE_SLF_XS (slf_init_rouse_wait);
2992 3068
2993 3069
… …
3030 adjust = 1 3106 adjust = 1
3031 CODE: 3107 CODE:
3032 coro_semaphore_adjust (aTHX_ (AV *)SvRV (self), ix ? adjust : 1); 3108 coro_semaphore_adjust (aTHX_ (AV *)SvRV (self), ix ? adjust : 1);
3033 3109
3034void 3110void
3035down (SV *self) 3111down (...)
3036 CODE: 3112 CODE:
3037 CORO_EXECUTE_SLF_XS (slf_init_semaphore_down); 3113 CORO_EXECUTE_SLF_XS (slf_init_semaphore_down);
3038 3114
3039void 3115void
3040wait (SV *self) 3116wait (...)
3041 CODE: 3117 CODE:
3042 CORO_EXECUTE_SLF_XS (slf_init_semaphore_wait); 3118 CORO_EXECUTE_SLF_XS (slf_init_semaphore_wait);
3043 3119
3044void 3120void
3045try (SV *self) 3121try (SV *self)
… …
3088 ); 3164 );
3089 OUTPUT: 3165 OUTPUT:
3090 RETVAL 3166 RETVAL
3091 3167
3092void 3168void
3093wait (SV *self) 3169wait (...)
3094 CODE: 3170 CODE:
3095 CORO_EXECUTE_SLF_XS (slf_init_signal_wait); 3171 CORO_EXECUTE_SLF_XS (slf_init_signal_wait);
3096 3172
3097void 3173void
3098broadcast (SV *self) 3174broadcast (SV *self)
… …
3155 3231
3156void 3232void
3157_register (char *target, char *proto, SV *req) 3233_register (char *target, char *proto, SV *req)
3158 CODE: 3234 CODE:
3159{ 3235{
3160 HV *st;
3161 GV *gvp;
3162 CV *req_cv = sv_2cv (req, &st, &gvp, 0); 3236 CV *req_cv = coro_sv_2cv (req);
3163 /* newXSproto doesn't return the CV on 5.8 */ 3237 /* newXSproto doesn't return the CV on 5.8 */
3164 CV *slf_cv = newXS (target, coro_aio_req_xs, __FILE__); 3238 CV *slf_cv = newXS (target, coro_aio_req_xs, __FILE__);
3165 sv_setpv ((SV *)slf_cv, proto); 3239 sv_setpv ((SV *)slf_cv, proto);
3166 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);
3167} 3241}

Diff Legend

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