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.108 by root, Mon Nov 27 18:15:47 2006 UTC vs.
Revision 1.111 by root, Thu Nov 30 18:21:14 2006 UTC

… …
119 /* cpu state */ 119 /* cpu state */
120 void *idle_sp; /* sp of top-level transfer/schedule/cede call */ 120 void *idle_sp; /* sp of top-level transfer/schedule/cede call */
121 JMPENV *top_env; 121 JMPENV *top_env;
122 coro_context cctx; 122 coro_context cctx;
123 123
124 int inuse;
125
124#if USE_VALGRIND 126#if USE_VALGRIND
125 int valgrind_id; 127 int valgrind_id;
126#endif 128#endif
127} coro_cctx; 129} coro_cctx;
130
131enum {
132 CF_RUNNING, /* coroutine is running */
133 CF_READY, /* coroutine is ready */
134};
128 135
129/* this is a structure representing a perl-level coroutine */ 136/* this is a structure representing a perl-level coroutine */
130struct coro { 137struct coro {
131 /* the c coroutine allocated to this perl coroutine, if any */ 138 /* the c coroutine allocated to this perl coroutine, if any */
132 coro_cctx *cctx; 139 coro_cctx *cctx;
133 140
134 /* data associated with this coroutine (initial args) */ 141 /* data associated with this coroutine (initial args) */
135 AV *args; 142 AV *args;
136 int refcnt; 143 int refcnt;
144 int flags;
137 145
138 /* optionally saved, might be zero */ 146 /* optionally saved, might be zero */
139 AV *defav; 147 AV *defav;
140 SV *defsv; 148 SV *defsv;
141 SV *errsv; 149 SV *errsv;
… …
214 222
215#define PERL_MAGIC_coro PERL_MAGIC_ext 223#define PERL_MAGIC_coro PERL_MAGIC_ext
216 224
217static MGVTBL vtbl_coro = {0, 0, 0, 0, coro_cv_free}; 225static MGVTBL vtbl_coro = {0, 0, 0, 0, coro_cv_free};
218 226
227#define CORO_MAGIC(cv) \
228 SvMAGIC (cv) \
229 ? SvMAGIC (cv)->mg_type == PERL_MAGIC_coro \
230 ? SvMAGIC (cv) \
231 : mg_find ((SV *)cv, PERL_MAGIC_coro) \
232 : 0
233
219/* the next two functions merely cache the padlists */ 234/* the next two functions merely cache the padlists */
220static void 235static void
221get_padlist (CV *cv) 236get_padlist (CV *cv)
222{ 237{
223 MAGIC *mg = mg_find ((SV *)cv, PERL_MAGIC_coro); 238 MAGIC *mg = CORO_MAGIC (cv);
239 AV *av;
224 240
225 if (mg && AvFILLp ((AV *)mg->mg_obj) >= 0) 241 if (mg && AvFILLp ((av = (AV *)mg->mg_obj)) >= 0)
226 CvPADLIST (cv) = (AV *)av_pop ((AV *)mg->mg_obj); 242 CvPADLIST (cv) = (AV *)AvARRAY (av)[AvFILLp (av)--];
227 else 243 else
228 { 244 {
229#if 0 245#if 0
230 /* this is probably cleaner, but also slower? */ 246 /* this is probably cleaner, but also slower? */
231 CV *cp = Perl_cv_clone (cv); 247 CV *cp = Perl_cv_clone (cv);
… …
239} 255}
240 256
241static void 257static void
242put_padlist (CV *cv) 258put_padlist (CV *cv)
243{ 259{
244 MAGIC *mg = mg_find ((SV *)cv, PERL_MAGIC_coro); 260 MAGIC *mg = CORO_MAGIC (cv);
261 AV *av;
245 262
246 if (!mg) 263 if (!mg)
247 { 264 {
248 sv_magic ((SV *)cv, 0, PERL_MAGIC_coro, 0, 0); 265 sv_magic ((SV *)cv, 0, PERL_MAGIC_coro, 0, 0);
249 mg = mg_find ((SV *)cv, PERL_MAGIC_coro); 266 mg = mg_find ((SV *)cv, PERL_MAGIC_coro);
250 mg->mg_virtual = &vtbl_coro; 267 mg->mg_virtual = &vtbl_coro;
251 mg->mg_obj = (SV *)newAV (); 268 mg->mg_obj = (SV *)newAV ();
252 } 269 }
253 270
254 av_push ((AV *)mg->mg_obj, (SV *)CvPADLIST (cv)); 271 av = (AV *)mg->mg_obj;
272
273 if (AvFILLp (av) >= AvMAX (av))
274 av_extend (av, AvMAX (av) + 1);
275
276 AvARRAY (av)[++AvFILLp (av)] = (SV *)CvPADLIST (cv);
255} 277}
256 278
257#define SB do { 279#define SB do {
258#define SE } while (0) 280#define SE } while (0)
259 281
… …
278 CV *cv; 300 CV *cv;
279 301
280 /* now do the ugly restore mess */ 302 /* now do the ugly restore mess */
281 while ((cv = (CV *)POPs)) 303 while ((cv = (CV *)POPs))
282 { 304 {
283 AV *padlist = (AV *)POPs;
284
285 if (padlist)
286 {
287 put_padlist (cv); /* mark this padlist as available */ 305 put_padlist (cv); /* mark this padlist as available */
288 CvPADLIST(cv) = padlist; 306 CvDEPTH (cv) = PTR2IV (POPs);
289 } 307 CvPADLIST (cv) = (AV *)POPs;
290
291 ++CvDEPTH(cv);
292 } 308 }
293 309
294 PUTBACK; 310 PUTBACK;
295 } 311 }
296} 312}
… …
318 PERL_CONTEXT *cx = &ccstk[cxix--]; 334 PERL_CONTEXT *cx = &ccstk[cxix--];
319 335
320 if (CxTYPE(cx) == CXt_SUB) 336 if (CxTYPE(cx) == CXt_SUB)
321 { 337 {
322 CV *cv = cx->blk_sub.cv; 338 CV *cv = cx->blk_sub.cv;
339
323 if (CvDEPTH(cv)) 340 if (CvDEPTH (cv))
324 { 341 {
325 EXTEND (SP, CvDEPTH(cv)*2); 342 EXTEND (SP, 3);
326
327 while (--CvDEPTH(cv))
328 {
329 /* this tells the restore code to increment CvDEPTH */
330 PUSHs (Nullsv);
331 PUSHs ((SV *)cv);
332 }
333 343
334 PUSHs ((SV *)CvPADLIST(cv)); 344 PUSHs ((SV *)CvPADLIST(cv));
345 PUSHs (INT2PTR (SV *, CvDEPTH (cv)));
335 PUSHs ((SV *)cv); 346 PUSHs ((SV *)cv);
336 347
348 CvDEPTH (cv) = 0;
337 get_padlist (cv); 349 get_padlist (cv);
338 } 350 }
339 } 351 }
340#ifdef CXt_FORMAT 352#ifdef CXt_FORMAT
341 else if (CxTYPE(cx) == CXt_FORMAT) 353 else if (CxTYPE(cx) == CXt_FORMAT)
… …
661 if (flags == TRANSFER_SET_STACKLEVEL) 673 if (flags == TRANSFER_SET_STACKLEVEL)
662 ((coro_cctx *)prev)->idle_sp = STACKLEVEL; 674 ((coro_cctx *)prev)->idle_sp = STACKLEVEL;
663 else if (prev != next) 675 else if (prev != next)
664 { 676 {
665 coro_cctx *prev__cctx; 677 coro_cctx *prev__cctx;
678
679 if (!prev->cctx)
680 {
681 /* create a new empty context */
682 Newz (0, prev->cctx, 1, coro_cctx);
683 prev->cctx->inuse = 1;
684 prev->flags |= CF_RUNNING;
685 }
686
687 assert ( prev->flags & CF_RUNNING);
688 assert (!next->flags & CF_RUNNING);
689
690 prev->flags &= ~CF_RUNNING;
691 next->flags |= CF_RUNNING;
666 692
667 LOCK; 693 LOCK;
668 694
669 if (next->mainstack) 695 if (next->mainstack)
670 { 696 {
… …
678 /* first get rid of the old state */ 704 /* first get rid of the old state */
679 SAVE (prev, -1); 705 SAVE (prev, -1);
680 /* setup coroutine call */ 706 /* setup coroutine call */
681 setup_coro (next); 707 setup_coro (next);
682 /* need a stack */ 708 /* need a stack */
709 assert (!next->stack);
683 next->cctx = 0; 710 next->cctx = 0;
684 } 711 }
685
686 if (!prev->cctx)
687 /* create a new empty context */
688 Newz (0, prev->cctx, 1, coro_cctx);
689 712
690 prev__cctx = prev->cctx; 713 prev__cctx = prev->cctx;
691 714
692 /* possibly "free" the cctx */ 715 /* possibly "free" the cctx */
693 if (prev__cctx->idle_sp == STACKLEVEL) 716 if (prev__cctx->idle_sp == STACKLEVEL)
694 { 717 {
718 assert (PL_top_env == prev__cctx->top_env);//D
695 cctx_put (prev__cctx); 719 cctx_put (prev__cctx);
696 prev->cctx = 0; 720 prev->cctx = 0;
697 } 721 }
698 722
699 if (!next->cctx) 723 if (!next->cctx)
700 next->cctx = cctx_get (); 724 next->cctx = cctx_get ();
701 725
702 if (prev__cctx != next->cctx) 726 if (prev__cctx != next->cctx)
703 { 727 {
728 assert ( prev__cctx->inuse);
729 assert (!next->cctx->inuse);
730
731 prev__cctx->inuse = 0;
732 next->cctx->inuse = 1;
733
704 prev__cctx->top_env = PL_top_env; 734 prev__cctx->top_env = PL_top_env;
705 PL_top_env = next->cctx->top_env; 735 PL_top_env = next->cctx->top_env;
706 coro_transfer (&prev__cctx->cctx, &next->cctx->cctx); 736 coro_transfer (&prev__cctx->cctx, &next->cctx->cctx);
707 } 737 }
708 738
… …
862 } 892 }
863 893
864 return 0; 894 return 0;
865} 895}
866 896
867static void 897static int
868api_ready (SV *coro) 898api_ready (SV *coro_sv)
869{ 899{
870 dTHX; 900 struct coro *coro;
871 901
872 if (SvROK (coro)) 902 if (SvROK (coro_sv))
873 coro = SvRV (coro); 903 coro_sv = SvRV (coro_sv);
904
905 coro = SvSTATE (coro_sv);
906 if (coro->flags & CF_READY)
907 return 0;
908
909 coro->flags |= CF_READY;
874 910
875 LOCK; 911 LOCK;
876 coro_enq (SvREFCNT_inc (coro)); 912 coro_enq (SvREFCNT_inc (coro_sv));
877 UNLOCK; 913 UNLOCK;
914
915 return 1;
916}
917
918static int
919api_is_ready (SV *coro_sv)
920{
921 struct coro *coro;
922
923 return !!(SvSTATE (coro_sv)->flags & CF_READY);
878} 924}
879 925
880static void 926static void
881prepare_schedule (struct transfer_args *ta) 927prepare_schedule (struct transfer_args *ta)
882{ 928{
… …
918 coro_mortal = prev; 964 coro_mortal = prev;
919 965
920 ta->prev = SvSTATE (prev); 966 ta->prev = SvSTATE (prev);
921 ta->next = SvSTATE (next); 967 ta->next = SvSTATE (next);
922 ta->flags = TRANSFER_SAVE_ALL; 968 ta->flags = TRANSFER_SAVE_ALL;
969
970 ta->next->flags &= ~CF_READY;
923} 971}
924 972
925static void 973static void
926prepare_cede (struct transfer_args *ta) 974prepare_cede (struct transfer_args *ta)
927{ 975{
928 LOCK; 976 api_ready (GvSV (coro_current));
929 coro_enq (SvREFCNT_inc (SvRV (GvSV (coro_current))));
930 UNLOCK;
931 977
932 prepare_schedule (ta); 978 prepare_schedule (ta);
933} 979}
934 980
935static void 981static void
… …
1121 SV *sv = perl_get_sv("Coro::API", 1); 1167 SV *sv = perl_get_sv("Coro::API", 1);
1122 1168
1123 coroapi.schedule = api_schedule; 1169 coroapi.schedule = api_schedule;
1124 coroapi.cede = api_cede; 1170 coroapi.cede = api_cede;
1125 coroapi.ready = api_ready; 1171 coroapi.ready = api_ready;
1172 coroapi.is_ready = api_is_ready;
1126 coroapi.nready = &coro_nready; 1173 coroapi.nready = &coro_nready;
1127 coroapi.current = coro_current; 1174 coroapi.current = coro_current;
1128 1175
1129 GCoroAPI = &coroapi; 1176 GCoroAPI = &coroapi;
1130 sv_setiv (sv, (IV)&coroapi); 1177 sv_setiv (sv, (IV)&coroapi);
… …
1150 1197
1151 coro->prio = newprio; 1198 coro->prio = newprio;
1152 } 1199 }
1153} 1200}
1154 1201
1155void 1202SV *
1156ready (SV *self) 1203ready (SV *self)
1157 PROTOTYPE: $ 1204 PROTOTYPE: $
1158 CODE: 1205 CODE:
1159 api_ready (self); 1206 RETVAL = boolSV (api_ready (self));
1207 OUTPUT:
1208 RETVAL
1209
1210SV *
1211is_ready (SV *self)
1212 PROTOTYPE: $
1213 CODE:
1214 RETVAL = boolSV (api_is_ready (self));
1215 OUTPUT:
1216 RETVAL
1160 1217
1161int 1218int
1162nready (...) 1219nready (...)
1163 PROTOTYPE: 1220 PROTOTYPE:
1164 CODE: 1221 CODE:

Diff Legend

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