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.309 by root, Wed Nov 19 15:29:57 2008 UTC

… …
165static size_t cctx_stacksize = CORO_STACKSIZE; 165static size_t cctx_stacksize = CORO_STACKSIZE;
166static struct CoroAPI coroapi; 166static struct CoroAPI coroapi;
167static AV *main_mainstack; /* used to differentiate between $main and others */ 167static AV *main_mainstack; /* used to differentiate between $main and others */
168static JMPENV *main_top_env; 168static JMPENV *main_top_env;
169static HV *coro_state_stash, *coro_stash; 169static HV *coro_state_stash, *coro_stash;
170static CV *coro_run_cv;
170static volatile SV *coro_mortal; /* will be freed/thrown after next transfer */ 171static volatile SV *coro_mortal; /* will be freed/thrown after next transfer */
171 172
172static GV *irsgv; /* $/ */ 173static GV *irsgv; /* $/ */
173static GV *stdoutgv; /* *STDOUT */ 174static GV *stdoutgv; /* *STDOUT */
174static SV *rv_diehook; 175static SV *rv_diehook;
… …
246 /* state data */ 247 /* state data */
247 struct CoroSLF slf_frame; /* saved slf frame */ 248 struct CoroSLF slf_frame; /* saved slf frame */
248 AV *mainstack; 249 AV *mainstack;
249 perl_slots *slot; /* basically the saved sp */ 250 perl_slots *slot; /* basically the saved sp */
250 251
252 CV *startcv; /* the CV to execute */
251 AV *args; /* data associated with this coroutine (initial args) */ 253 AV *args; /* data associated with this coroutine (initial args) */
252 int refcnt; /* coroutines are refcounted, yes */ 254 int refcnt; /* coroutines are refcounted, yes */
253 int flags; /* CF_ flags */ 255 int flags; /* CF_ flags */
254 HV *hv; /* the perl hash associated with this coro, if any */ 256 HV *hv; /* the perl hash associated with this coro, if any */
255 void (*on_destroy)(pTHX_ struct coro *coro); 257 void (*on_destroy)(pTHX_ struct coro *coro);
256 258
257 /* statistics */ 259 /* statistics */
258 int usecount; /* number of transfers to this coro */ 260 int usecount; /* number of transfers to this coro */
259 261
… …
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
… …
2143 SV **ary; 2159 SV **ary;
2144 2160
2145 /* unfortunately, building manually saves memory */ 2161 /* unfortunately, building manually saves memory */
2146 Newx (ary, 2, SV *); 2162 Newx (ary, 2, SV *);
2147 AvALLOC (av) = ary; 2163 AvALLOC (av) = ary;
2148 AvARRAY (av) = ary; 2164 /*AvARRAY (av) = ary;*/
2165 SvPVX ((SV *)av) = (char *)ary; /* 5.8.8 needs this syntax instead of AvARRAY = ary */
2149 AvMAX (av) = 1; 2166 AvMAX (av) = 1;
2150 AvFILLp (av) = 0; 2167 AvFILLp (av) = 0;
2151 ary [0] = newSViv (count); 2168 ary [0] = newSViv (count);
2152 2169
2153 return newRV_noinc ((SV *)av); 2170 return newRV_noinc ((SV *)av);
… …
2173 AvARRAY (av)[0] = AvARRAY (av)[1]; 2190 AvARRAY (av)[0] = AvARRAY (av)[1];
2174 AvARRAY (av)[1] = count_sv; 2191 AvARRAY (av)[1] = count_sv;
2175 cb = av_shift (av); 2192 cb = av_shift (av);
2176 2193
2177 if (SvOBJECT (cb)) 2194 if (SvOBJECT (cb))
2195 {
2178 api_ready (aTHX_ cb); 2196 api_ready (aTHX_ cb);
2179 else 2197 --count;
2180 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 }
2181 2207
2182 SvREFCNT_dec (cb); 2208 SvREFCNT_dec (cb);
2183
2184 --count;
2185 } 2209 }
2186} 2210}
2187 2211
2188static void 2212static void
2189coro_semaphore_on_destroy (pTHX_ struct coro *coro) 2213coro_semaphore_on_destroy (pTHX_ struct coro *coro)
… …
2271} 2295}
2272 2296
2273static void 2297static void
2274slf_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)
2275{ 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 {
2276 slf_init_semaphore_down_or_wait (aTHX_ frame, cv, arg, items); 2316 slf_init_semaphore_down_or_wait (aTHX_ frame, cv, arg, items);
2277 frame->check = slf_check_semaphore_wait; 2317 frame->check = slf_check_semaphore_wait;
2318 }
2278} 2319}
2279 2320
2280/* signal */ 2321/* signal */
2281 2322
2282static void 2323static void
… …
2574 assert (("PRIO_NORMAL must be 0", !PRIO_NORMAL)); 2615 assert (("PRIO_NORMAL must be 0", !PRIO_NORMAL));
2575} 2616}
2576 2617
2577SV * 2618SV *
2578new (char *klass, ...) 2619new (char *klass, ...)
2620 ALIAS:
2621 Coro::new = 1
2579 CODE: 2622 CODE:
2580{ 2623{
2581 struct coro *coro; 2624 struct coro *coro;
2582 MAGIC *mg; 2625 MAGIC *mg;
2583 HV *hv; 2626 HV *hv;
2627 CV *cb;
2584 int i; 2628 int i;
2629
2630 if (items > 1)
2631 {
2632 cb = coro_sv_2cv (ST (1));
2633
2634 if (CvISXSUB (cb))
2635 croak ("Coro::State doesn't support XS functions as coroutine start, caught");
2636
2637 if (!CvROOT (cb))
2638 croak ("Coro::State doesn't support autoloaded or undefined functions as coroutine start, caught");
2639 }
2585 2640
2586 Newz (0, coro, 1, struct coro); 2641 Newz (0, coro, 1, struct coro);
2587 coro->args = newAV (); 2642 coro->args = newAV ();
2588 coro->flags = CF_NEW; 2643 coro->flags = CF_NEW;
2589 2644
… …
2594 coro->hv = hv = newHV (); 2649 coro->hv = hv = newHV ();
2595 mg = sv_magicext ((SV *)hv, 0, CORO_MAGIC_type_state, &coro_state_vtbl, (char *)coro, 0); 2650 mg = sv_magicext ((SV *)hv, 0, CORO_MAGIC_type_state, &coro_state_vtbl, (char *)coro, 0);
2596 mg->mg_flags |= MGf_DUP; 2651 mg->mg_flags |= MGf_DUP;
2597 RETVAL = sv_bless (newRV_noinc ((SV *)hv), gv_stashpv (klass, 1)); 2652 RETVAL = sv_bless (newRV_noinc ((SV *)hv), gv_stashpv (klass, 1));
2598 2653
2654 if (items > 1)
2655 {
2599 av_extend (coro->args, items - 1); 2656 av_extend (coro->args, items - 1 + ix);
2657
2658 if (ix)
2659 {
2660 av_push (coro->args, SvREFCNT_inc_NN ((SV *)cb));
2661 cb = coro_run_cv;
2662 }
2663
2664 coro->startcv = (CV *)SvREFCNT_inc_NN ((SV *)cb);
2665
2600 for (i = 1; i < items; i++) 2666 for (i = 2; i < items; i++)
2601 av_push (coro->args, newSVsv (ST (i))); 2667 av_push (coro->args, newSVsv (ST (i)));
2668 }
2602} 2669}
2603 OUTPUT: 2670 OUTPUT:
2604 RETVAL 2671 RETVAL
2605 2672
2606void 2673void
… …
2807 int i; 2874 int i;
2808 2875
2809 av_async_pool = coro_get_av (aTHX_ "Coro::async_pool", TRUE); 2876 av_async_pool = coro_get_av (aTHX_ "Coro::async_pool", TRUE);
2810 sv_pool_rss = coro_get_sv (aTHX_ "Coro::POOL_RSS" , TRUE); 2877 sv_pool_rss = coro_get_sv (aTHX_ "Coro::POOL_RSS" , TRUE);
2811 sv_pool_size = coro_get_sv (aTHX_ "Coro::POOL_SIZE" , TRUE); 2878 sv_pool_size = coro_get_sv (aTHX_ "Coro::POOL_SIZE" , TRUE);
2812 2879 coro_run_cv = get_cv (aTHX_ "Coro::_terminate", GV_ADD);
2813 coro_current = coro_get_sv (aTHX_ "Coro::current", FALSE); 2880 coro_current = coro_get_sv (aTHX_ "Coro::current" , FALSE);
2814 SvREADONLY_on (coro_current); 2881 SvREADONLY_on (coro_current);
2815 2882
2816 coro_stash = gv_stashpv ("Coro", TRUE); 2883 coro_stash = gv_stashpv ("Coro", TRUE);
2817 2884
2818 newCONSTSUB (coro_stash, "PRIO_MAX", newSViv (PRIO_MAX)); 2885 newCONSTSUB (coro_stash, "PRIO_MAX", newSViv (PRIO_MAX));
… …
2989 RETVAL = coro_new_rouse_cb (aTHX); 3056 RETVAL = coro_new_rouse_cb (aTHX);
2990 OUTPUT: 3057 OUTPUT:
2991 RETVAL 3058 RETVAL
2992 3059
2993void 3060void
2994rouse_wait (SV *cb = 0) 3061rouse_wait (...)
2995 PROTOTYPE: ;$ 3062 PROTOTYPE: ;$
2996 PPCODE: 3063 PPCODE:
2997 CORO_EXECUTE_SLF_XS (slf_init_rouse_wait); 3064 CORO_EXECUTE_SLF_XS (slf_init_rouse_wait);
2998 3065
2999 3066
… …
3036 adjust = 1 3103 adjust = 1
3037 CODE: 3104 CODE:
3038 coro_semaphore_adjust (aTHX_ (AV *)SvRV (self), ix ? adjust : 1); 3105 coro_semaphore_adjust (aTHX_ (AV *)SvRV (self), ix ? adjust : 1);
3039 3106
3040void 3107void
3041down (SV *self) 3108down (...)
3042 CODE: 3109 CODE:
3043 CORO_EXECUTE_SLF_XS (slf_init_semaphore_down); 3110 CORO_EXECUTE_SLF_XS (slf_init_semaphore_down);
3044 3111
3045void 3112void
3046wait (SV *self) 3113wait (...)
3047 CODE: 3114 CODE:
3048 CORO_EXECUTE_SLF_XS (slf_init_semaphore_wait); 3115 CORO_EXECUTE_SLF_XS (slf_init_semaphore_wait);
3049 3116
3050void 3117void
3051try (SV *self) 3118try (SV *self)
… …
3094 ); 3161 );
3095 OUTPUT: 3162 OUTPUT:
3096 RETVAL 3163 RETVAL
3097 3164
3098void 3165void
3099wait (SV *self) 3166wait (...)
3100 CODE: 3167 CODE:
3101 CORO_EXECUTE_SLF_XS (slf_init_signal_wait); 3168 CORO_EXECUTE_SLF_XS (slf_init_signal_wait);
3102 3169
3103void 3170void
3104broadcast (SV *self) 3171broadcast (SV *self)
… …
3161 3228
3162void 3229void
3163_register (char *target, char *proto, SV *req) 3230_register (char *target, char *proto, SV *req)
3164 CODE: 3231 CODE:
3165{ 3232{
3166 HV *st;
3167 GV *gvp;
3168 CV *req_cv = sv_2cv (req, &st, &gvp, 0); 3233 CV *req_cv = coro_sv_2cv (req);
3169 /* newXSproto doesn't return the CV on 5.8 */ 3234 /* newXSproto doesn't return the CV on 5.8 */
3170 CV *slf_cv = newXS (target, coro_aio_req_xs, __FILE__); 3235 CV *slf_cv = newXS (target, coro_aio_req_xs, __FILE__);
3171 sv_setpv ((SV *)slf_cv, proto); 3236 sv_setpv ((SV *)slf_cv, proto);
3172 sv_magicext ((SV *)slf_cv, (SV *)req_cv, CORO_MAGIC_type_aio, 0, 0, 0); 3237 sv_magicext ((SV *)slf_cv, (SV *)req_cv, CORO_MAGIC_type_aio, 0, 0, 0);
3173} 3238}

Diff Legend

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