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.119 by root, Sat Dec 2 15:41:28 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 = 0x0001, /* coroutine is running */
136 CF_READY = 0x0002, /* coroutine is ready */
137 CF_NEW = 0x0004, /* ahs never been switched to */
138};
128 139
129/* this is a structure representing a perl-level coroutine */ 140/* this is a structure representing a perl-level coroutine */
130struct coro { 141struct coro {
131 /* the c coroutine allocated to this perl coroutine, if any */ 142 /* the c coroutine allocated to this perl coroutine, if any */
132 coro_cctx *cctx; 143 coro_cctx *cctx;
133 144
134 /* data associated with this coroutine (initial args) */ 145 /* data associated with this coroutine (initial args) */
135 AV *args; 146 AV *args;
136 int refcnt; 147 int refcnt;
148 int flags;
137 149
138 /* optionally saved, might be zero */ 150 /* optionally saved, might be zero */
139 AV *defav; 151 AV *defav;
140 SV *defsv; 152 SV *defsv;
141 SV *errsv; 153 SV *errsv;
… …
214 226
215#define PERL_MAGIC_coro PERL_MAGIC_ext 227#define PERL_MAGIC_coro PERL_MAGIC_ext
216 228
217static MGVTBL vtbl_coro = {0, 0, 0, 0, coro_cv_free}; 229static MGVTBL vtbl_coro = {0, 0, 0, 0, coro_cv_free};
218 230
231#define CORO_MAGIC(cv) \
232 SvMAGIC (cv) \
233 ? SvMAGIC (cv)->mg_type == PERL_MAGIC_coro \
234 ? SvMAGIC (cv) \
235 : mg_find ((SV *)cv, PERL_MAGIC_coro) \
236 : 0
237
219/* the next two functions merely cache the padlists */ 238/* the next two functions merely cache the padlists */
220static void 239static void
221get_padlist (CV *cv) 240get_padlist (CV *cv)
222{ 241{
223 MAGIC *mg = mg_find ((SV *)cv, PERL_MAGIC_coro); 242 MAGIC *mg = CORO_MAGIC (cv);
243 AV *av;
224 244
225 if (mg && AvFILLp ((AV *)mg->mg_obj) >= 0) 245 if (mg && AvFILLp ((av = (AV *)mg->mg_obj)) >= 0)
226 CvPADLIST (cv) = (AV *)av_pop ((AV *)mg->mg_obj); 246 CvPADLIST (cv) = (AV *)AvARRAY (av)[AvFILLp (av)--];
227 else 247 else
228 { 248 {
229#if 0 249#if 0
230 /* this is probably cleaner, but also slower? */ 250 /* this is probably cleaner, but also slower? */
231 CV *cp = Perl_cv_clone (cv); 251 CV *cp = Perl_cv_clone (cv);
… …
239} 259}
240 260
241static void 261static void
242put_padlist (CV *cv) 262put_padlist (CV *cv)
243{ 263{
244 MAGIC *mg = mg_find ((SV *)cv, PERL_MAGIC_coro); 264 MAGIC *mg = CORO_MAGIC (cv);
265 AV *av;
245 266
246 if (!mg) 267 if (!mg)
247 { 268 {
248 sv_magic ((SV *)cv, 0, PERL_MAGIC_coro, 0, 0); 269 sv_magic ((SV *)cv, 0, PERL_MAGIC_coro, 0, 0);
249 mg = mg_find ((SV *)cv, PERL_MAGIC_coro); 270 mg = mg_find ((SV *)cv, PERL_MAGIC_coro);
250 mg->mg_virtual = &vtbl_coro; 271 mg->mg_virtual = &vtbl_coro;
251 mg->mg_obj = (SV *)newAV (); 272 mg->mg_obj = (SV *)newAV ();
252 } 273 }
253 274
254 av_push ((AV *)mg->mg_obj, (SV *)CvPADLIST (cv)); 275 av = (AV *)mg->mg_obj;
276
277 if (AvFILLp (av) >= AvMAX (av))
278 av_extend (av, AvMAX (av) + 1);
279
280 AvARRAY (av)[++AvFILLp (av)] = (SV *)CvPADLIST (cv);
255} 281}
256 282
257#define SB do { 283#define SB do {
258#define SE } while (0) 284#define SE } while (0)
259 285
260#define LOAD(state) load_state((state)); 286#define LOAD(state) load_state ((state))
261#define SAVE(state,flags) save_state((state),(flags)); 287#define SAVE(state,flags) save_state ((state),(flags))
262 288
263#define REPLACE_SV(sv,val) SB SvREFCNT_dec(sv); (sv) = (val); (val) = 0; SE 289#define REPLACE_SV(sv,val) SB SvREFCNT_dec (sv); (sv) = (val); (val) = 0; SE
264 290
265static void 291static void
266load_state(Coro__State c) 292load_state (Coro__State c)
267{ 293{
268#define VAR(name,type) PL_ ## name = c->name; 294#define VAR(name,type) PL_ ## name = c->name;
269# include "state.h" 295# include "state.h"
270#undef VAR 296#undef VAR
271 297
… …
278 CV *cv; 304 CV *cv;
279 305
280 /* now do the ugly restore mess */ 306 /* now do the ugly restore mess */
281 while ((cv = (CV *)POPs)) 307 while ((cv = (CV *)POPs))
282 { 308 {
283 AV *padlist = (AV *)POPs;
284
285 if (padlist)
286 {
287 put_padlist (cv); /* mark this padlist as available */ 309 put_padlist (cv); /* mark this padlist as available */
288 CvPADLIST(cv) = padlist; 310 CvDEPTH (cv) = PTR2IV (POPs);
289 } 311 CvPADLIST (cv) = (AV *)POPs;
290
291 ++CvDEPTH(cv);
292 } 312 }
293 313
294 PUTBACK; 314 PUTBACK;
295 } 315 }
296} 316}
297 317
298static void 318static void
299save_state(Coro__State c, int flags) 319save_state (Coro__State c, int flags)
300{ 320{
301 { 321 {
302 dSP; 322 dSP;
303 I32 cxix = cxstack_ix; 323 I32 cxix = cxstack_ix;
304 PERL_CONTEXT *ccstk = cxstack; 324 PERL_CONTEXT *ccstk = cxstack;
… …
315 { 335 {
316 while (cxix >= 0) 336 while (cxix >= 0)
317 { 337 {
318 PERL_CONTEXT *cx = &ccstk[cxix--]; 338 PERL_CONTEXT *cx = &ccstk[cxix--];
319 339
320 if (CxTYPE(cx) == CXt_SUB) 340 if (CxTYPE (cx) == CXt_SUB)
321 { 341 {
322 CV *cv = cx->blk_sub.cv; 342 CV *cv = cx->blk_sub.cv;
343
323 if (CvDEPTH(cv)) 344 if (CvDEPTH (cv))
324 { 345 {
325 EXTEND (SP, CvDEPTH(cv)*2); 346 EXTEND (SP, 3);
326 347
327 while (--CvDEPTH(cv))
328 {
329 /* this tells the restore code to increment CvDEPTH */
330 PUSHs (Nullsv);
331 PUSHs ((SV *)cv);
332 }
333
334 PUSHs ((SV *)CvPADLIST(cv)); 348 PUSHs ((SV *)CvPADLIST (cv));
349 PUSHs (INT2PTR (SV *, CvDEPTH (cv)));
335 PUSHs ((SV *)cv); 350 PUSHs ((SV *)cv);
336 351
352 CvDEPTH (cv) = 0;
337 get_padlist (cv); 353 get_padlist (cv);
338 } 354 }
339 } 355 }
340#ifdef CXt_FORMAT 356#ifdef CXt_FORMAT
341 else if (CxTYPE(cx) == CXt_FORMAT) 357 else if (CxTYPE (cx) == CXt_FORMAT)
342 { 358 {
343 /* I never used formats, so how should I know how these are implemented? */ 359 /* I never used formats, so how should I know how these are implemented? */
344 /* my bold guess is as a simple, plain sub... */ 360 /* my bold guess is as a simple, plain sub... */
345 croak ("CXt_FORMAT not yet handled. Don't switch coroutines from within formats"); 361 croak ("CXt_FORMAT not yet handled. Don't switch coroutines from within formats");
346 } 362 }
… …
374 * not usually need a lot of stackspace. 390 * not usually need a lot of stackspace.
375 */ 391 */
376static void 392static void
377coro_init_stacks () 393coro_init_stacks ()
378{ 394{
379 PL_curstackinfo = new_stackinfo(96, 1024/sizeof(PERL_CONTEXT) - 1); 395 PL_curstackinfo = new_stackinfo(128, 1024/sizeof(PERL_CONTEXT));
380 PL_curstackinfo->si_type = PERLSI_MAIN; 396 PL_curstackinfo->si_type = PERLSI_MAIN;
381 PL_curstack = PL_curstackinfo->si_stack; 397 PL_curstack = PL_curstackinfo->si_stack;
382 PL_mainstack = PL_curstack; /* remember in case we switch stacks */ 398 PL_mainstack = PL_curstack; /* remember in case we switch stacks */
383 399
384 PL_stack_base = AvARRAY(PL_curstack); 400 PL_stack_base = AvARRAY(PL_curstack);
385 PL_stack_sp = PL_stack_base; 401 PL_stack_sp = PL_stack_base;
386 PL_stack_max = PL_stack_base + AvMAX(PL_curstack); 402 PL_stack_max = PL_stack_base + AvMAX(PL_curstack);
387 403
388 New(50,PL_tmps_stack,96,SV*); 404 New(50,PL_tmps_stack,128,SV*);
389 PL_tmps_floor = -1; 405 PL_tmps_floor = -1;
390 PL_tmps_ix = -1; 406 PL_tmps_ix = -1;
391 PL_tmps_max = 96; 407 PL_tmps_max = 128;
392 408
393 New(54,PL_markstack,16,I32); 409 New(54,PL_markstack,32,I32);
394 PL_markstack_ptr = PL_markstack; 410 PL_markstack_ptr = PL_markstack;
395 PL_markstack_max = PL_markstack + 16; 411 PL_markstack_max = PL_markstack + 32;
396 412
397#ifdef SET_MARK_OFFSET 413#ifdef SET_MARK_OFFSET
398 SET_MARK_OFFSET; 414 SET_MARK_OFFSET;
399#endif 415#endif
400 416
401 New(54,PL_scopestack,16,I32); 417 New(54,PL_scopestack,32,I32);
402 PL_scopestack_ix = 0; 418 PL_scopestack_ix = 0;
403 PL_scopestack_max = 16; 419 PL_scopestack_max = 32;
404 420
405 New(54,PL_savestack,96,ANY); 421 New(54,PL_savestack,64,ANY);
406 PL_savestack_ix = 0; 422 PL_savestack_ix = 0;
407 PL_savestack_max = 96; 423 PL_savestack_max = 64;
408 424
409#if !PERL_VERSION_ATLEAST (5,9,0) 425#if !PERL_VERSION_ATLEAST (5,9,0)
410 New(54,PL_retstack,8,OP*); 426 New(54,PL_retstack,16,OP*);
411 PL_retstack_ix = 0; 427 PL_retstack_ix = 0;
412 PL_retstack_max = 8; 428 PL_retstack_max = 16;
413#endif 429#endif
414} 430}
415 431
416/* 432/*
417 * destroy the stacks, the callchain etc... 433 * destroy the stacks, the callchain etc...
… …
470 * emulate part of the perl startup here. 486 * emulate part of the perl startup here.
471 */ 487 */
472 488
473 coro_init_stacks (); 489 coro_init_stacks ();
474 490
475 PL_curcop = 0; 491 PL_curcop = &PL_compiling;
476 PL_in_eval = 0; 492 PL_in_eval = EVAL_NULL;
477 PL_curpm = 0; 493 PL_curpm = 0;
494 PL_localizing = 0;
495 PL_dirty = 0;
496 PL_restartop = 0;
478 497
479 { 498 {
480 dSP; 499 dSP;
481 LOGOP myop; 500 LOGOP myop;
482 501
… …
495 PUSHMARK (SP); 514 PUSHMARK (SP);
496 XPUSHs ((SV *)get_cv ("Coro::State::_coro_init", FALSE)); 515 XPUSHs ((SV *)get_cv ("Coro::State::_coro_init", FALSE));
497 PUTBACK; 516 PUTBACK;
498 PL_op = PL_ppaddr[OP_ENTERSUB](aTHX); 517 PL_op = PL_ppaddr[OP_ENTERSUB](aTHX);
499 SPAGAIN; 518 SPAGAIN;
500
501 ENTER; /* necessary e.g. for dounwind */
502 } 519 }
520
521 ENTER; /* necessary e.g. for dounwind */
503} 522}
504 523
505static void 524static void
506free_coro_mortal () 525free_coro_mortal ()
507{ 526{
… …
601 620
602 return cctx; 621 return cctx;
603} 622}
604 623
605static void 624static void
606cctx_free (coro_cctx *cctx) 625cctx_destroy (coro_cctx *cctx)
607{ 626{
608 if (!cctx) 627 if (!cctx)
609 return; 628 return;
610 629
611 --cctx_count; 630 --cctx_count;
… …
628{ 647{
629 coro_cctx *cctx; 648 coro_cctx *cctx;
630 649
631 if (cctx_first) 650 if (cctx_first)
632 { 651 {
633 --cctx_idle;
634 cctx = cctx_first; 652 cctx = cctx_first;
635 cctx_first = cctx->next; 653 cctx_first = cctx->next;
654 --cctx_idle;
636 } 655 }
637 else 656 else
638 { 657 {
639 cctx = cctx_new (); 658 cctx = cctx_new ();
640 PL_op = PL_op->op_next; 659 PL_op = PL_op->op_next;
… …
644} 663}
645 664
646static void 665static void
647cctx_put (coro_cctx *cctx) 666cctx_put (coro_cctx *cctx)
648{ 667{
668 /* free another cctx if overlimit */
669 if (cctx_idle >= MAX_IDLE_CCTX)
670 {
671 coro_cctx *first = cctx_first;
672 cctx_first = first->next;
673 --cctx_idle;
674
675 assert (!first->inuse);
676 cctx_destroy (first);
677 }
678
649 ++cctx_idle; 679 ++cctx_idle;
650 cctx->next = cctx_first; 680 cctx->next = cctx_first;
651 cctx_first = cctx; 681 cctx_first = cctx;
652} 682}
653 683
… …
662 ((coro_cctx *)prev)->idle_sp = STACKLEVEL; 692 ((coro_cctx *)prev)->idle_sp = STACKLEVEL;
663 else if (prev != next) 693 else if (prev != next)
664 { 694 {
665 coro_cctx *prev__cctx; 695 coro_cctx *prev__cctx;
666 696
697 if (prev->flags & CF_NEW)
698 {
699 /* create a new empty context */
700 Newz (0, prev->cctx, 1, coro_cctx);
701 prev->cctx->inuse = 1;
702 prev->flags &= ~CF_NEW;
703 prev->flags |= CF_RUNNING;
704 }
705
706 /*TODO: must not croak here */
707 if (!prev->flags & CF_RUNNING)
708 croak ("Coro::State::transfer called with non-running prev Coro::State, but can only transfer from running states");
709
710 if (next->flags & CF_RUNNING)
711 croak ("Coro::State::transfer called with running next Coro::State, but can only transfer to inactive states");
712
713 prev->flags &= ~CF_RUNNING;
714 next->flags |= CF_RUNNING;
715
667 LOCK; 716 LOCK;
668 717
669 if (next->mainstack) 718 if (next->flags & CF_NEW)
719 {
720 /* need to start coroutine */
721 next->flags &= ~CF_NEW;
722 /* first get rid of the old state */
723 SAVE (prev, -1);
724 /* setup coroutine call */
725 setup_coro (next);
726 /* need a new stack */
727 assert (!next->stack);
728 }
729 else
670 { 730 {
671 /* coroutine already started */ 731 /* coroutine already started */
672 SAVE (prev, flags); 732 SAVE (prev, flags);
673 LOAD (next); 733 LOAD (next);
674 } 734 }
675 else
676 {
677 /* need to start coroutine */
678 /* first get rid of the old state */
679 SAVE (prev, -1);
680 /* setup coroutine call */
681 setup_coro (next);
682 /* need a stack */
683 next->cctx = 0;
684 }
685
686 if (!prev->cctx)
687 /* create a new empty context */
688 Newz (0, prev->cctx, 1, coro_cctx);
689 735
690 prev__cctx = prev->cctx; 736 prev__cctx = prev->cctx;
691 737
692 /* possibly "free" the cctx */ 738 /* possibly "free" the cctx */
693 if (prev__cctx->idle_sp == STACKLEVEL) 739 if (prev__cctx->idle_sp == STACKLEVEL)
694 { 740 {
741 /* I assume that STACKLEVEL is a stronger indicator than PL_top_env changes */
742 assert (PL_top_env == prev__cctx->top_env);
743
744 prev->cctx = 0;
745
695 cctx_put (prev__cctx); 746 cctx_put (prev__cctx);
696 prev->cctx = 0; 747 prev__cctx->inuse = 0;
697 } 748 }
698 749
699 if (!next->cctx) 750 if (!next->cctx)
751 {
700 next->cctx = cctx_get (); 752 next->cctx = cctx_get ();
753 assert (!next->cctx->inuse);
754 next->cctx->inuse = 1;
755 }
701 756
702 if (prev__cctx != next->cctx) 757 if (prev__cctx != next->cctx)
703 { 758 {
704 prev__cctx->top_env = PL_top_env; 759 prev__cctx->top_env = PL_top_env;
705 PL_top_env = next->cctx->top_env; 760 PL_top_env = next->cctx->top_env;
… …
728 783
729 if (coro->mainstack && coro->mainstack != main_mainstack) 784 if (coro->mainstack && coro->mainstack != main_mainstack)
730 { 785 {
731 struct coro temp; 786 struct coro temp;
732 787
788 if (coro->flags & CF_RUNNING)
789 croak ("FATAL: tried to destroy currently running coroutine");
790
733 SAVE ((&temp), TRANSFER_SAVE_ALL); 791 SAVE ((&temp), TRANSFER_SAVE_ALL);
734 LOAD (coro); 792 LOAD (coro);
735 793
736 coro_destroy_stacks (); 794 coro_destroy_stacks ();
737 795
738 LOAD ((&temp)); /* this will get rid of defsv etc.. */ 796 LOAD ((&temp)); /* this will get rid of defsv etc.. */
739 797
740 coro->mainstack = 0; 798 coro->mainstack = 0;
741 } 799 }
742 800
743 cctx_free (coro->cctx); 801 cctx_destroy (coro->cctx);
744 SvREFCNT_dec (coro->args); 802 SvREFCNT_dec (coro->args);
745 Safefree (coro); 803 Safefree (coro);
746} 804}
747 805
748static int 806static int
… …
808} 866}
809 867
810static void 868static void
811api_transfer (SV *prev, SV *next, int flags) 869api_transfer (SV *prev, SV *next, int flags)
812{ 870{
813 dTHX;
814 struct transfer_args ta; 871 struct transfer_args ta;
815 872
816 prepare_transfer (&ta, prev, next, flags); 873 prepare_transfer (&ta, prev, next, flags);
817 TRANSFER (ta); 874 TRANSFER (ta);
818} 875}
… …
825#define PRIO_LOW -1 882#define PRIO_LOW -1
826#define PRIO_IDLE -3 883#define PRIO_IDLE -3
827#define PRIO_MIN -4 884#define PRIO_MIN -4
828 885
829/* for Coro.pm */ 886/* for Coro.pm */
830static GV *coro_current, *coro_idle; 887static SV *coro_current;
831static AV *coro_ready [PRIO_MAX-PRIO_MIN+1]; 888static AV *coro_ready [PRIO_MAX-PRIO_MIN+1];
832static int coro_nready; 889static int coro_nready;
833 890
834static void 891static void
835coro_enq (SV *sv) 892coro_enq (SV *coro_sv)
836{ 893{
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); 894 av_push (coro_ready [SvSTATE (coro_sv)->prio - PRIO_MIN], coro_sv);
845 coro_nready++; 895 coro_nready++;
846} 896}
847 897
848static SV * 898static SV *
849coro_deq (int min_prio) 899coro_deq (int min_prio)
… …
862 } 912 }
863 913
864 return 0; 914 return 0;
865} 915}
866 916
867static void 917static int
868api_ready (SV *coro) 918api_ready (SV *coro_sv)
869{ 919{
870 dTHX; 920 struct coro *coro;
871 921
872 if (SvROK (coro)) 922 if (SvROK (coro_sv))
873 coro = SvRV (coro); 923 coro_sv = SvRV (coro_sv);
924
925 coro = SvSTATE (coro_sv);
926
927 if (coro->flags & CF_READY)
928 return 0;
929
930#if 0 /* this is actually harmless */
931 if (coro->flags & CF_RUNNING)
932 croak ("Coro::ready called on currently running coroutine");
933#endif
934
935 coro->flags |= CF_READY;
874 936
875 LOCK; 937 LOCK;
876 coro_enq (SvREFCNT_inc (coro)); 938 coro_enq (SvREFCNT_inc (coro_sv));
877 UNLOCK; 939 UNLOCK;
940
941 return 1;
942}
943
944static int
945api_is_ready (SV *coro_sv)
946{
947 return !!SvSTATE (coro_sv)->flags & CF_READY;
878} 948}
879 949
880static void 950static void
881prepare_schedule (struct transfer_args *ta) 951prepare_schedule (struct transfer_args *ta)
882{ 952{
883 SV *current, *prev, *next; 953 SV *prev, *next;
884
885 current = GvSV (coro_current);
886 954
887 for (;;) 955 for (;;)
888 { 956 {
889 LOCK; 957 LOCK;
890 next = coro_deq (PRIO_MIN); 958 next = coro_deq (PRIO_MIN);
… …
899 ENTER; 967 ENTER;
900 SAVETMPS; 968 SAVETMPS;
901 969
902 PUSHMARK (SP); 970 PUSHMARK (SP);
903 PUTBACK; 971 PUTBACK;
904 call_sv (GvSV (coro_idle), G_DISCARD); 972 call_sv (get_sv ("Coro::idle", FALSE), G_DISCARD);
905 973
906 FREETMPS; 974 FREETMPS;
907 LEAVE; 975 LEAVE;
908 } 976 }
909 } 977 }
910 978
911 prev = SvRV (current); 979 prev = SvRV (coro_current);
912 SvRV (current) = next; 980 SvRV_set (coro_current, next);
913 981
914 /* free this only after the transfer */ 982 /* free this only after the transfer */
915 LOCK; 983 LOCK;
916 free_coro_mortal (); 984 free_coro_mortal ();
917 UNLOCK; 985 UNLOCK;
918 coro_mortal = prev; 986 coro_mortal = prev;
919 987
988 assert (!SvROK(prev));//D
989 assert (!SvROK(next));//D
990
920 ta->prev = SvSTATE (prev); 991 ta->prev = SvSTATE (prev);
921 ta->next = SvSTATE (next); 992 ta->next = SvSTATE (next);
922 ta->flags = TRANSFER_SAVE_ALL; 993 ta->flags = TRANSFER_SAVE_ALL;
994
995 assert (ta->flags & CF_READY);
996 ta->next->flags &= ~CF_READY;
923} 997}
924 998
925static void 999static void
926prepare_cede (struct transfer_args *ta) 1000prepare_cede (struct transfer_args *ta)
927{ 1001{
928 LOCK; 1002 api_ready (coro_current);
929 coro_enq (SvREFCNT_inc (SvRV (GvSV (coro_current))));
930 UNLOCK;
931 1003
932 prepare_schedule (ta); 1004 prepare_schedule (ta);
933} 1005}
934 1006
935static void 1007static void
936api_schedule (void) 1008api_schedule (void)
937{ 1009{
938 dTHX;
939 struct transfer_args ta; 1010 struct transfer_args ta;
940 1011
941 prepare_schedule (&ta); 1012 prepare_schedule (&ta);
942 TRANSFER (ta); 1013 TRANSFER (ta);
943} 1014}
944 1015
945static void 1016static void
946api_cede (void) 1017api_cede (void)
947{ 1018{
948 dTHX;
949 struct transfer_args ta; 1019 struct transfer_args ta;
950 1020
951 prepare_cede (&ta); 1021 prepare_cede (&ta);
952 TRANSFER (ta); 1022 TRANSFER (ta);
953} 1023}
… …
985 HV *hv; 1055 HV *hv;
986 int i; 1056 int i;
987 1057
988 Newz (0, coro, 1, struct coro); 1058 Newz (0, coro, 1, struct coro);
989 coro->args = newAV (); 1059 coro->args = newAV ();
1060 coro->flags = CF_NEW;
990 1061
991 hv = newHV (); 1062 hv = newHV ();
992 sv_magicext ((SV *)hv, 0, PERL_MAGIC_ext, &coro_state_vtbl, (char *)coro, 0)->mg_flags |= MGf_DUP; 1063 sv_magicext ((SV *)hv, 0, PERL_MAGIC_ext, &coro_state_vtbl, (char *)coro, 0)->mg_flags |= MGf_DUP;
993 RETVAL = sv_bless (newRV_noinc ((SV *)hv), gv_stashpv (klass, 1)); 1064 RETVAL = sv_bless (newRV_noinc ((SV *)hv), gv_stashpv (klass, 1));
994 1065
… …
1002_set_stacklevel (...) 1073_set_stacklevel (...)
1003 ALIAS: 1074 ALIAS:
1004 Coro::State::transfer = 1 1075 Coro::State::transfer = 1
1005 Coro::schedule = 2 1076 Coro::schedule = 2
1006 Coro::cede = 3 1077 Coro::cede = 3
1007 Coro::Cont::yield = 4
1008 CODE: 1078 CODE:
1009{ 1079{
1010 struct transfer_args ta; 1080 struct transfer_args ta;
1011 1081
1012 switch (ix) 1082 switch (ix)
… …
1017 ta.flags = TRANSFER_SET_STACKLEVEL; 1087 ta.flags = TRANSFER_SET_STACKLEVEL;
1018 break; 1088 break;
1019 1089
1020 case 1: 1090 case 1:
1021 if (items != 3) 1091 if (items != 3)
1022 croak ("Coro::State::transfer(prev,next,flags) expects three arguments, not %d", items); 1092 croak ("Coro::State::transfer (prev,next,flags) expects three arguments, not %d", items);
1023 1093
1024 prepare_transfer (&ta, ST (0), ST (1), SvIV (ST (2))); 1094 prepare_transfer (&ta, ST (0), ST (1), SvIV (ST (2)));
1025 break; 1095 break;
1026 1096
1027 case 2: 1097 case 2:
… …
1029 break; 1099 break;
1030 1100
1031 case 3: 1101 case 3:
1032 prepare_cede (&ta); 1102 prepare_cede (&ta);
1033 break; 1103 break;
1034
1035 case 4:
1036 {
1037 SV *yieldstack;
1038 SV *sv;
1039 AV *defav = GvAV (PL_defgv);
1040
1041 yieldstack = *hv_fetch (
1042 (HV *)SvRV (GvSV (coro_current)),
1043 "yieldstack", sizeof ("yieldstack") - 1,
1044 0
1045 );
1046
1047 /* set up @_ -- ugly */
1048 av_clear (defav);
1049 av_fill (defav, items - 1);
1050 while (items--)
1051 av_store (defav, items, SvREFCNT_inc (ST(items)));
1052
1053 sv = av_pop ((AV *)SvRV (yieldstack));
1054 ta.prev = SvSTATE (*av_fetch ((AV *)SvRV (sv), 0, 0));
1055 ta.next = SvSTATE (*av_fetch ((AV *)SvRV (sv), 1, 0));
1056 ta.flags = 0;
1057 SvREFCNT_dec (sv);
1058 }
1059 break;
1060
1061 } 1104 }
1062 1105
1063 TRANSFER (ta); 1106 TRANSFER (ta);
1064} 1107}
1065 1108
… …
1109 newCONSTSUB (coro_stash, "PRIO_NORMAL", newSViv (PRIO_NORMAL)); 1152 newCONSTSUB (coro_stash, "PRIO_NORMAL", newSViv (PRIO_NORMAL));
1110 newCONSTSUB (coro_stash, "PRIO_LOW", newSViv (PRIO_LOW)); 1153 newCONSTSUB (coro_stash, "PRIO_LOW", newSViv (PRIO_LOW));
1111 newCONSTSUB (coro_stash, "PRIO_IDLE", newSViv (PRIO_IDLE)); 1154 newCONSTSUB (coro_stash, "PRIO_IDLE", newSViv (PRIO_IDLE));
1112 newCONSTSUB (coro_stash, "PRIO_MIN", newSViv (PRIO_MIN)); 1155 newCONSTSUB (coro_stash, "PRIO_MIN", newSViv (PRIO_MIN));
1113 1156
1114 coro_current = gv_fetchpv ("Coro::current", TRUE, SVt_PV); 1157 coro_current = get_sv ("Coro::current", FALSE);
1115 coro_idle = gv_fetchpv ("Coro::idle" , TRUE, SVt_PV); 1158 SvREADONLY_on (coro_current);
1116 1159
1117 for (i = PRIO_MAX - PRIO_MIN + 1; i--; ) 1160 for (i = PRIO_MAX - PRIO_MIN + 1; i--; )
1118 coro_ready[i] = newAV (); 1161 coro_ready[i] = newAV ();
1119 1162
1120 { 1163 {
1121 SV *sv = perl_get_sv("Coro::API", 1); 1164 SV *sv = perl_get_sv("Coro::API", 1);
1122 1165
1123 coroapi.schedule = api_schedule; 1166 coroapi.schedule = api_schedule;
1124 coroapi.cede = api_cede; 1167 coroapi.cede = api_cede;
1125 coroapi.ready = api_ready; 1168 coroapi.ready = api_ready;
1169 coroapi.is_ready = api_is_ready;
1126 coroapi.nready = &coro_nready; 1170 coroapi.nready = &coro_nready;
1127 coroapi.current = coro_current; 1171 coroapi.current = coro_current;
1128 1172
1129 GCoroAPI = &coroapi; 1173 GCoroAPI = &coroapi;
1130 sv_setiv (sv, (IV)&coroapi); 1174 sv_setiv (sv, (IV)&coroapi);
… …
1150 1194
1151 coro->prio = newprio; 1195 coro->prio = newprio;
1152 } 1196 }
1153} 1197}
1154 1198
1155void 1199SV *
1156ready (SV *self) 1200ready (SV *self)
1157 PROTOTYPE: $ 1201 PROTOTYPE: $
1158 CODE: 1202 CODE:
1159 api_ready (self); 1203 RETVAL = boolSV (api_ready (self));
1204 OUTPUT:
1205 RETVAL
1206
1207SV *
1208is_ready (SV *self)
1209 PROTOTYPE: $
1210 CODE:
1211 RETVAL = boolSV (api_is_ready (self));
1212 OUTPUT:
1213 RETVAL
1160 1214
1161int 1215int
1162nready (...) 1216nready (...)
1163 PROTOTYPE: 1217 PROTOTYPE:
1164 CODE: 1218 CODE:
1165 RETVAL = coro_nready; 1219 RETVAL = coro_nready;
1166 OUTPUT: 1220 OUTPUT:
1167 RETVAL 1221 RETVAL
1168 1222
1223void
1224_set_current (SV *current)
1225 PROTOTYPE: $
1226 CODE:
1227 SvREFCNT_dec (SvRV (coro_current));
1228 SvRV_set (coro_current, SvREFCNT_inc (SvRV (current)));
1229
1169MODULE = Coro::State PACKAGE = Coro::AIO 1230MODULE = Coro::State PACKAGE = Coro::AIO
1170 1231
1171SV * 1232SV *
1172_get_state () 1233_get_state ()
1173 CODE: 1234 CODE:

Diff Legend

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