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.116 by root, Fri Dec 1 14:01:43 2006 UTC

… …
7#include "patchlevel.h" 7#include "patchlevel.h"
8 8
9#if USE_VALGRIND 9#if USE_VALGRIND
10# include <valgrind/valgrind.h> 10# include <valgrind/valgrind.h>
11#endif 11#endif
12
13/* the maximum number of idle cctx that will be pooled */
14#define MAX_IDLE_CCTX 8
12 15
13#define PERL_VERSION_ATLEAST(a,b,c) \ 16#define PERL_VERSION_ATLEAST(a,b,c) \
14 (PERL_REVISION > (a) \ 17 (PERL_REVISION > (a) \
15 || (PERL_REVISION == (a) \ 18 || (PERL_REVISION == (a) \
16 && (PERL_VERSION > (b) \ 19 && (PERL_VERSION > (b) \
… …
119 /* cpu state */ 122 /* cpu state */
120 void *idle_sp; /* sp of top-level transfer/schedule/cede call */ 123 void *idle_sp; /* sp of top-level transfer/schedule/cede call */
121 JMPENV *top_env; 124 JMPENV *top_env;
122 coro_context cctx; 125 coro_context cctx;
123 126
127 int inuse;
128
124#if USE_VALGRIND 129#if USE_VALGRIND
125 int valgrind_id; 130 int valgrind_id;
126#endif 131#endif
127} coro_cctx; 132} coro_cctx;
133
134enum {
135 CF_RUNNING, /* coroutine is running */
136 CF_READY, /* coroutine is ready */
137};
128 138
129/* this is a structure representing a perl-level coroutine */ 139/* this is a structure representing a perl-level coroutine */
130struct coro { 140struct coro {
131 /* the c coroutine allocated to this perl coroutine, if any */ 141 /* the c coroutine allocated to this perl coroutine, if any */
132 coro_cctx *cctx; 142 coro_cctx *cctx;
133 143
134 /* data associated with this coroutine (initial args) */ 144 /* data associated with this coroutine (initial args) */
135 AV *args; 145 AV *args;
136 int refcnt; 146 int refcnt;
147 int flags;
137 148
138 /* optionally saved, might be zero */ 149 /* optionally saved, might be zero */
139 AV *defav; 150 AV *defav;
140 SV *defsv; 151 SV *defsv;
141 SV *errsv; 152 SV *errsv;
… …
214 225
215#define PERL_MAGIC_coro PERL_MAGIC_ext 226#define PERL_MAGIC_coro PERL_MAGIC_ext
216 227
217static MGVTBL vtbl_coro = {0, 0, 0, 0, coro_cv_free}; 228static MGVTBL vtbl_coro = {0, 0, 0, 0, coro_cv_free};
218 229
230#define CORO_MAGIC(cv) \
231 SvMAGIC (cv) \
232 ? SvMAGIC (cv)->mg_type == PERL_MAGIC_coro \
233 ? SvMAGIC (cv) \
234 : mg_find ((SV *)cv, PERL_MAGIC_coro) \
235 : 0
236
219/* the next two functions merely cache the padlists */ 237/* the next two functions merely cache the padlists */
220static void 238static void
221get_padlist (CV *cv) 239get_padlist (CV *cv)
222{ 240{
223 MAGIC *mg = mg_find ((SV *)cv, PERL_MAGIC_coro); 241 MAGIC *mg = CORO_MAGIC (cv);
242 AV *av;
224 243
225 if (mg && AvFILLp ((AV *)mg->mg_obj) >= 0) 244 if (mg && AvFILLp ((av = (AV *)mg->mg_obj)) >= 0)
226 CvPADLIST (cv) = (AV *)av_pop ((AV *)mg->mg_obj); 245 CvPADLIST (cv) = (AV *)AvARRAY (av)[AvFILLp (av)--];
227 else 246 else
228 { 247 {
229#if 0 248#if 0
230 /* this is probably cleaner, but also slower? */ 249 /* this is probably cleaner, but also slower? */
231 CV *cp = Perl_cv_clone (cv); 250 CV *cp = Perl_cv_clone (cv);
… …
239} 258}
240 259
241static void 260static void
242put_padlist (CV *cv) 261put_padlist (CV *cv)
243{ 262{
244 MAGIC *mg = mg_find ((SV *)cv, PERL_MAGIC_coro); 263 MAGIC *mg = CORO_MAGIC (cv);
264 AV *av;
245 265
246 if (!mg) 266 if (!mg)
247 { 267 {
248 sv_magic ((SV *)cv, 0, PERL_MAGIC_coro, 0, 0); 268 sv_magic ((SV *)cv, 0, PERL_MAGIC_coro, 0, 0);
249 mg = mg_find ((SV *)cv, PERL_MAGIC_coro); 269 mg = mg_find ((SV *)cv, PERL_MAGIC_coro);
250 mg->mg_virtual = &vtbl_coro; 270 mg->mg_virtual = &vtbl_coro;
251 mg->mg_obj = (SV *)newAV (); 271 mg->mg_obj = (SV *)newAV ();
252 } 272 }
253 273
254 av_push ((AV *)mg->mg_obj, (SV *)CvPADLIST (cv)); 274 av = (AV *)mg->mg_obj;
275
276 if (AvFILLp (av) >= AvMAX (av))
277 av_extend (av, AvMAX (av) + 1);
278
279 AvARRAY (av)[++AvFILLp (av)] = (SV *)CvPADLIST (cv);
255} 280}
256 281
257#define SB do { 282#define SB do {
258#define SE } while (0) 283#define SE } while (0)
259 284
… …
278 CV *cv; 303 CV *cv;
279 304
280 /* now do the ugly restore mess */ 305 /* now do the ugly restore mess */
281 while ((cv = (CV *)POPs)) 306 while ((cv = (CV *)POPs))
282 { 307 {
283 AV *padlist = (AV *)POPs;
284
285 if (padlist)
286 {
287 put_padlist (cv); /* mark this padlist as available */ 308 put_padlist (cv); /* mark this padlist as available */
288 CvPADLIST(cv) = padlist; 309 CvDEPTH (cv) = PTR2IV (POPs);
289 } 310 CvPADLIST (cv) = (AV *)POPs;
290
291 ++CvDEPTH(cv);
292 } 311 }
293 312
294 PUTBACK; 313 PUTBACK;
295 } 314 }
296} 315}
… …
318 PERL_CONTEXT *cx = &ccstk[cxix--]; 337 PERL_CONTEXT *cx = &ccstk[cxix--];
319 338
320 if (CxTYPE(cx) == CXt_SUB) 339 if (CxTYPE(cx) == CXt_SUB)
321 { 340 {
322 CV *cv = cx->blk_sub.cv; 341 CV *cv = cx->blk_sub.cv;
342
323 if (CvDEPTH(cv)) 343 if (CvDEPTH (cv))
324 { 344 {
325 EXTEND (SP, CvDEPTH(cv)*2); 345 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 346
334 PUSHs ((SV *)CvPADLIST(cv)); 347 PUSHs ((SV *)CvPADLIST(cv));
348 PUSHs (INT2PTR (SV *, CvDEPTH (cv)));
335 PUSHs ((SV *)cv); 349 PUSHs ((SV *)cv);
336 350
351 CvDEPTH (cv) = 0;
337 get_padlist (cv); 352 get_padlist (cv);
338 } 353 }
339 } 354 }
340#ifdef CXt_FORMAT 355#ifdef CXt_FORMAT
341 else if (CxTYPE(cx) == CXt_FORMAT) 356 else if (CxTYPE(cx) == CXt_FORMAT)
… …
374 * not usually need a lot of stackspace. 389 * not usually need a lot of stackspace.
375 */ 390 */
376static void 391static void
377coro_init_stacks () 392coro_init_stacks ()
378{ 393{
379 PL_curstackinfo = new_stackinfo(96, 1024/sizeof(PERL_CONTEXT) - 1); 394 PL_curstackinfo = new_stackinfo(128, 1024/sizeof(PERL_CONTEXT));
380 PL_curstackinfo->si_type = PERLSI_MAIN; 395 PL_curstackinfo->si_type = PERLSI_MAIN;
381 PL_curstack = PL_curstackinfo->si_stack; 396 PL_curstack = PL_curstackinfo->si_stack;
382 PL_mainstack = PL_curstack; /* remember in case we switch stacks */ 397 PL_mainstack = PL_curstack; /* remember in case we switch stacks */
383 398
384 PL_stack_base = AvARRAY(PL_curstack); 399 PL_stack_base = AvARRAY(PL_curstack);
385 PL_stack_sp = PL_stack_base; 400 PL_stack_sp = PL_stack_base;
386 PL_stack_max = PL_stack_base + AvMAX(PL_curstack); 401 PL_stack_max = PL_stack_base + AvMAX(PL_curstack);
387 402
388 New(50,PL_tmps_stack,96,SV*); 403 New(50,PL_tmps_stack,128,SV*);
389 PL_tmps_floor = -1; 404 PL_tmps_floor = -1;
390 PL_tmps_ix = -1; 405 PL_tmps_ix = -1;
391 PL_tmps_max = 96; 406 PL_tmps_max = 128;
392 407
393 New(54,PL_markstack,16,I32); 408 New(54,PL_markstack,32,I32);
394 PL_markstack_ptr = PL_markstack; 409 PL_markstack_ptr = PL_markstack;
395 PL_markstack_max = PL_markstack + 16; 410 PL_markstack_max = PL_markstack + 32;
396 411
397#ifdef SET_MARK_OFFSET 412#ifdef SET_MARK_OFFSET
398 SET_MARK_OFFSET; 413 SET_MARK_OFFSET;
399#endif 414#endif
400 415
401 New(54,PL_scopestack,16,I32); 416 New(54,PL_scopestack,32,I32);
402 PL_scopestack_ix = 0; 417 PL_scopestack_ix = 0;
403 PL_scopestack_max = 16; 418 PL_scopestack_max = 32;
404 419
405 New(54,PL_savestack,96,ANY); 420 New(54,PL_savestack,64,ANY);
406 PL_savestack_ix = 0; 421 PL_savestack_ix = 0;
407 PL_savestack_max = 96; 422 PL_savestack_max = 64;
408 423
409#if !PERL_VERSION_ATLEAST (5,9,0) 424#if !PERL_VERSION_ATLEAST (5,9,0)
410 New(54,PL_retstack,8,OP*); 425 New(54,PL_retstack,16,OP*);
411 PL_retstack_ix = 0; 426 PL_retstack_ix = 0;
412 PL_retstack_max = 8; 427 PL_retstack_max = 16;
413#endif 428#endif
414} 429}
415 430
416/* 431/*
417 * destroy the stacks, the callchain etc... 432 * destroy the stacks, the callchain etc...
… …
601 616
602 return cctx; 617 return cctx;
603} 618}
604 619
605static void 620static void
606cctx_free (coro_cctx *cctx) 621cctx_destroy (coro_cctx *cctx)
607{ 622{
608 if (!cctx) 623 if (!cctx)
609 return; 624 return;
610 625
611 --cctx_count; 626 --cctx_count;
… …
628{ 643{
629 coro_cctx *cctx; 644 coro_cctx *cctx;
630 645
631 if (cctx_first) 646 if (cctx_first)
632 { 647 {
633 --cctx_idle;
634 cctx = cctx_first; 648 cctx = cctx_first;
635 cctx_first = cctx->next; 649 cctx_first = cctx->next;
650 --cctx_idle;
636 } 651 }
637 else 652 else
638 { 653 {
639 cctx = cctx_new (); 654 cctx = cctx_new ();
640 PL_op = PL_op->op_next; 655 PL_op = PL_op->op_next;
… …
644} 659}
645 660
646static void 661static void
647cctx_put (coro_cctx *cctx) 662cctx_put (coro_cctx *cctx)
648{ 663{
664 /* free another cctx if overlimit */
665 if (cctx_idle >= MAX_IDLE_CCTX)
666 {
667 coro_cctx *first = cctx_first;
668 cctx_first = first->next;
669 --cctx_idle;
670
671 assert (!first->inuse);
672 cctx_destroy (first);
673 }
674
649 ++cctx_idle; 675 ++cctx_idle;
650 cctx->next = cctx_first; 676 cctx->next = cctx_first;
651 cctx_first = cctx; 677 cctx_first = cctx;
652} 678}
653 679
… …
661 if (flags == TRANSFER_SET_STACKLEVEL) 687 if (flags == TRANSFER_SET_STACKLEVEL)
662 ((coro_cctx *)prev)->idle_sp = STACKLEVEL; 688 ((coro_cctx *)prev)->idle_sp = STACKLEVEL;
663 else if (prev != next) 689 else if (prev != next)
664 { 690 {
665 coro_cctx *prev__cctx; 691 coro_cctx *prev__cctx;
692
693 if (!prev->cctx)
694 {
695 /* create a new empty context */
696 Newz (0, prev->cctx, 1, coro_cctx);
697 prev->cctx->inuse = 1;
698 prev->flags |= CF_RUNNING;
699 }
700
701 if (!prev->flags & CF_RUNNING)
702 croak ("Coro::State::transfer called with non-running prev Coro::State, but can only transfer from running states");
703
704 if (next->flags & CF_RUNNING)
705 croak ("Coro::State::transfer called with running next Coro::State, but can only transfer to inactive states");
706
707 prev->flags &= ~CF_RUNNING;
708 next->flags |= CF_RUNNING;
666 709
667 LOCK; 710 LOCK;
668 711
669 if (next->mainstack) 712 if (next->mainstack)
670 { 713 {
… …
677 /* need to start coroutine */ 720 /* need to start coroutine */
678 /* first get rid of the old state */ 721 /* first get rid of the old state */
679 SAVE (prev, -1); 722 SAVE (prev, -1);
680 /* setup coroutine call */ 723 /* setup coroutine call */
681 setup_coro (next); 724 setup_coro (next);
682 /* need a stack */ 725 /* need a new stack */
683 next->cctx = 0; 726 assert (!next->stack);
684 } 727 }
685
686 if (!prev->cctx)
687 /* create a new empty context */
688 Newz (0, prev->cctx, 1, coro_cctx);
689 728
690 prev__cctx = prev->cctx; 729 prev__cctx = prev->cctx;
691 730
692 /* possibly "free" the cctx */ 731 /* possibly "free" the cctx */
693 if (prev__cctx->idle_sp == STACKLEVEL) 732 if (prev__cctx->idle_sp == STACKLEVEL)
694 { 733 {
734 /* I assume that STACKLEVEL is a stronger indicator than PL_top_env changes */
735 assert (PL_top_env == prev__cctx->top_env);
736
695 cctx_put (prev__cctx); 737 cctx_put (prev__cctx);
696 prev->cctx = 0; 738 prev->cctx = 0;
697 } 739 }
698 740
699 if (!next->cctx) 741 if (!next->cctx)
700 next->cctx = cctx_get (); 742 next->cctx = cctx_get ();
701 743
702 if (prev__cctx != next->cctx) 744 if (prev__cctx != next->cctx)
703 { 745 {
746 assert ( prev__cctx->inuse);
747 assert (!next->cctx->inuse);
748
749 prev__cctx->inuse = 0;
750 next->cctx->inuse = 1;
751
704 prev__cctx->top_env = PL_top_env; 752 prev__cctx->top_env = PL_top_env;
705 PL_top_env = next->cctx->top_env; 753 PL_top_env = next->cctx->top_env;
706 coro_transfer (&prev__cctx->cctx, &next->cctx->cctx); 754 coro_transfer (&prev__cctx->cctx, &next->cctx->cctx);
707 } 755 }
708 756
… …
724coro_state_destroy (struct coro *coro) 772coro_state_destroy (struct coro *coro)
725{ 773{
726 if (coro->refcnt--) 774 if (coro->refcnt--)
727 return; 775 return;
728 776
777 if (coro->flags & CF_RUNNING)
778 croak ("FATAL: tried to destroy currently running coroutine");
779
729 if (coro->mainstack && coro->mainstack != main_mainstack) 780 if (coro->mainstack && coro->mainstack != main_mainstack)
730 { 781 {
731 struct coro temp; 782 struct coro temp;
732 783
733 SAVE ((&temp), TRANSFER_SAVE_ALL); 784 SAVE ((&temp), TRANSFER_SAVE_ALL);
… …
738 LOAD ((&temp)); /* this will get rid of defsv etc.. */ 789 LOAD ((&temp)); /* this will get rid of defsv etc.. */
739 790
740 coro->mainstack = 0; 791 coro->mainstack = 0;
741 } 792 }
742 793
743 cctx_free (coro->cctx); 794 cctx_destroy (coro->cctx);
744 SvREFCNT_dec (coro->args); 795 SvREFCNT_dec (coro->args);
745 Safefree (coro); 796 Safefree (coro);
746} 797}
747 798
748static int 799static int
… …
830static GV *coro_current, *coro_idle; 881static GV *coro_current, *coro_idle;
831static AV *coro_ready [PRIO_MAX-PRIO_MIN+1]; 882static AV *coro_ready [PRIO_MAX-PRIO_MIN+1];
832static int coro_nready; 883static int coro_nready;
833 884
834static void 885static void
835coro_enq (SV *sv) 886coro_enq (SV *coro_sv)
836{ 887{
837 int prio;
838
839 if (SvTYPE (sv) != SVt_PVHV)
840 croak ("Coro::ready tried to enqueue something that is not a coroutine");
841
842 prio = SvSTATE (sv)->prio;
843
844 av_push (coro_ready [prio - PRIO_MIN], sv); 888 av_push (coro_ready [SvSTATE (coro_sv)->prio - PRIO_MIN], coro_sv);
845 coro_nready++; 889 coro_nready++;
846} 890}
847 891
848static SV * 892static SV *
849coro_deq (int min_prio) 893coro_deq (int min_prio)
… …
862 } 906 }
863 907
864 return 0; 908 return 0;
865} 909}
866 910
867static void 911static int
868api_ready (SV *coro) 912api_ready (SV *coro_sv)
869{ 913{
870 dTHX; 914 struct coro *coro;
871 915
872 if (SvROK (coro)) 916 if (SvROK (coro_sv))
873 coro = SvRV (coro); 917 coro_sv = SvRV (coro_sv);
918
919 coro = SvSTATE (coro_sv);
920
921 if (coro->flags & CF_READY)
922 return 0;
923
924 if (coro->flags & CF_RUNNING)
925 croak ("Coro::ready called on currently running coroutine");
926
927 coro->flags |= CF_READY;
874 928
875 LOCK; 929 LOCK;
876 coro_enq (SvREFCNT_inc (coro)); 930 coro_enq (SvREFCNT_inc (coro_sv));
877 UNLOCK; 931 UNLOCK;
932
933 return 1;
934}
935
936static int
937api_is_ready (SV *coro_sv)
938{
939 return !!SvSTATE (coro_sv)->flags & CF_READY;
878} 940}
879 941
880static void 942static void
881prepare_schedule (struct transfer_args *ta) 943prepare_schedule (struct transfer_args *ta)
882{ 944{
… …
918 coro_mortal = prev; 980 coro_mortal = prev;
919 981
920 ta->prev = SvSTATE (prev); 982 ta->prev = SvSTATE (prev);
921 ta->next = SvSTATE (next); 983 ta->next = SvSTATE (next);
922 ta->flags = TRANSFER_SAVE_ALL; 984 ta->flags = TRANSFER_SAVE_ALL;
985
986 ta->next->flags &= ~CF_READY;
923} 987}
924 988
925static void 989static void
926prepare_cede (struct transfer_args *ta) 990prepare_cede (struct transfer_args *ta)
927{ 991{
928 LOCK; 992 api_ready (GvSV (coro_current));
929 coro_enq (SvREFCNT_inc (SvRV (GvSV (coro_current))));
930 UNLOCK;
931 993
932 prepare_schedule (ta); 994 prepare_schedule (ta);
933} 995}
934 996
935static void 997static void
… …
1121 SV *sv = perl_get_sv("Coro::API", 1); 1183 SV *sv = perl_get_sv("Coro::API", 1);
1122 1184
1123 coroapi.schedule = api_schedule; 1185 coroapi.schedule = api_schedule;
1124 coroapi.cede = api_cede; 1186 coroapi.cede = api_cede;
1125 coroapi.ready = api_ready; 1187 coroapi.ready = api_ready;
1188 coroapi.is_ready = api_is_ready;
1126 coroapi.nready = &coro_nready; 1189 coroapi.nready = &coro_nready;
1127 coroapi.current = coro_current; 1190 coroapi.current = coro_current;
1128 1191
1129 GCoroAPI = &coroapi; 1192 GCoroAPI = &coroapi;
1130 sv_setiv (sv, (IV)&coroapi); 1193 sv_setiv (sv, (IV)&coroapi);
… …
1150 1213
1151 coro->prio = newprio; 1214 coro->prio = newprio;
1152 } 1215 }
1153} 1216}
1154 1217
1155void 1218SV *
1156ready (SV *self) 1219ready (SV *self)
1157 PROTOTYPE: $ 1220 PROTOTYPE: $
1158 CODE: 1221 CODE:
1159 api_ready (self); 1222 RETVAL = boolSV (api_ready (self));
1223 OUTPUT:
1224 RETVAL
1225
1226SV *
1227is_ready (SV *self)
1228 PROTOTYPE: $
1229 CODE:
1230 RETVAL = boolSV (api_is_ready (self));
1231 OUTPUT:
1232 RETVAL
1160 1233
1161int 1234int
1162nready (...) 1235nready (...)
1163 PROTOTYPE: 1236 PROTOTYPE:
1164 CODE: 1237 CODE:

Diff Legend

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