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.123 by root, Mon Dec 4 21:56:00 2006 UTC vs.
Revision 1.138 by root, Sun Jan 14 20:49:45 2007 UTC

… …
4#include "perl.h" 4#include "perl.h"
5#include "XSUB.h" 5#include "XSUB.h"
6 6
7#include "patchlevel.h" 7#include "patchlevel.h"
8 8
9#if USE_VALGRIND
10# include <valgrind/valgrind.h>
11#endif
12
13/* the maximum number of idle cctx that will be pooled */
14#define MAX_IDLE_CCTX 8
15
16#define PERL_VERSION_ATLEAST(a,b,c) \
17 (PERL_REVISION > (a) \
18 || (PERL_REVISION == (a) \
19 && (PERL_VERSION > (b) \
20 || (PERL_VERSION == (b) && PERLSUBVERSION >= (c)))))
21
22#if !PERL_VERSION_ATLEAST (5,6,0)
23# ifndef PL_ppaddr
24# define PL_ppaddr ppaddr
25# endif
26# ifndef call_sv
27# define call_sv perl_call_sv
28# endif
29# ifndef get_sv
30# define get_sv perl_get_sv
31# endif
32# ifndef get_cv
33# define get_cv perl_get_cv
34# endif
35# ifndef IS_PADGV
36# define IS_PADGV(v) 0
37# endif
38# ifndef IS_PADCONST
39# define IS_PADCONST(v) 0
40# endif
41#endif
42
43#include <stdio.h> 9#include <stdio.h>
44#include <errno.h> 10#include <errno.h>
45 11#include <assert.h>
46#if !__i386 && !__x86_64 && !__powerpc && !__m68k && !__alpha && !__mips && !__sparc64
47# undef STACKGUARD
48#endif
49
50#ifndef STACKGUARD
51# define STACKGUARD 0
52#endif
53 12
54#ifdef HAVE_MMAP 13#ifdef HAVE_MMAP
55# include <unistd.h> 14# include <unistd.h>
56# include <sys/mman.h> 15# include <sys/mman.h>
57# ifndef MAP_ANONYMOUS 16# ifndef MAP_ANONYMOUS
… …
72#else 31#else
73# define PAGESIZE 0 32# define PAGESIZE 0
74# define BOOT_PAGESIZE (void)0 33# define BOOT_PAGESIZE (void)0
75#endif 34#endif
76 35
36#if USE_VALGRIND
37# include <valgrind/valgrind.h>
38#endif
39
40/* the maximum number of idle cctx that will be pooled */
41#define MAX_IDLE_CCTX 8
42
43#define PERL_VERSION_ATLEAST(a,b,c) \
44 (PERL_REVISION > (a) \
45 || (PERL_REVISION == (a) \
46 && (PERL_VERSION > (b) \
47 || (PERL_VERSION == (b) && PERLSUBVERSION >= (c)))))
48
49#if !PERL_VERSION_ATLEAST (5,6,0)
50# ifndef PL_ppaddr
51# define PL_ppaddr ppaddr
52# endif
53# ifndef call_sv
54# define call_sv perl_call_sv
55# endif
56# ifndef get_sv
57# define get_sv perl_get_sv
58# endif
59# ifndef get_cv
60# define get_cv perl_get_cv
61# endif
62# ifndef IS_PADGV
63# define IS_PADGV(v) 0
64# endif
65# ifndef IS_PADCONST
66# define IS_PADCONST(v) 0
67# endif
68#endif
69
70/* 5.8.7 */
71#ifndef SvRV_set
72# define SvRV_set(s,v) SvRV(s) = (v)
73#endif
74
75#if !__i386 && !__x86_64 && !__powerpc && !__m68k && !__alpha && !__mips && !__sparc64
76# undef STACKGUARD
77#endif
78
79#ifndef STACKGUARD
80# define STACKGUARD 0
81#endif
82
83/* prefer perl internal functions over our own? */
84#ifndef PREFER_PERL_FUNCTIONS
85# define PREFER_PERL_FUNCTIONS 0
86#endif
87
77/* The next macro should declare a variable stacklevel that contains and approximation 88/* The next macro should declare a variable stacklevel that contains and approximation
78 * to the current C stack pointer. Its property is that it changes with each call 89 * to the current C stack pointer. Its property is that it changes with each call
79 * and should be unique. */ 90 * and should be unique. */
80#define dSTACKLEVEL int stacklevel 91#define dSTACKLEVEL int stacklevel
81#define STACKLEVEL ((void *)&stacklevel) 92#define STACKLEVEL ((void *)&stacklevel)
82 93
83#define IN_DESTRUCT (PL_main_cv == Nullcv) 94#define IN_DESTRUCT (PL_main_cv == Nullcv)
84 95
85#if __GNUC__ >= 3 96#if __GNUC__ >= 3
86# define attribute(x) __attribute__(x) 97# define attribute(x) __attribute__(x)
98# define BARRIER __asm__ __volatile__ ("" : : : "memory")
87#else 99#else
88# define attribute(x) 100# define attribute(x)
101# define BARRIER
89#endif 102#endif
90 103
91#define NOINLINE attribute ((noinline)) 104#define NOINLINE attribute ((noinline))
92 105
93#include "CoroAPI.h" 106#include "CoroAPI.h"
… …
99#else 112#else
100# define LOCK (void)0 113# define LOCK (void)0
101# define UNLOCK (void)0 114# define UNLOCK (void)0
102#endif 115#endif
103 116
117/* helper storage struct for Coro::AIO */
104struct io_state 118struct io_state
105{ 119{
106 int errorno; 120 int errorno;
107 I32 laststype; 121 I32 laststype;
108 int laststatval; 122 int laststatval;
… …
124 /* the stack */ 138 /* the stack */
125 void *sptr; 139 void *sptr;
126 long ssize; /* positive == mmap, otherwise malloc */ 140 long ssize; /* positive == mmap, otherwise malloc */
127 141
128 /* cpu state */ 142 /* cpu state */
129 void *idle_sp; /* sp of top-level transfer/schedule/cede call */ 143 void *idle_sp; /* sp of top-level transfer/schedule/cede call */
144 JMPENV *idle_te; /* same as idle_sp, but for top_env, TODO: remove once stable */
130 JMPENV *top_env; 145 JMPENV *top_env;
131 coro_context cctx; 146 coro_context cctx;
132 147
133 int inuse; 148 int inuse;
134 149
… …
136 int valgrind_id; 151 int valgrind_id;
137#endif 152#endif
138} coro_cctx; 153} coro_cctx;
139 154
140enum { 155enum {
141 CF_RUNNING = 0x0001, /* coroutine is running */ 156 CF_RUNNING = 0x0001, /* coroutine is running */
142 CF_READY = 0x0002, /* coroutine is ready */ 157 CF_READY = 0x0002, /* coroutine is ready */
143 CF_NEW = 0x0004, /* ahs never been switched to */ 158 CF_NEW = 0x0004, /* has never been switched to */
159 CF_DESTROYED = 0x0008, /* coroutine data has been freed */
144}; 160};
145 161
146/* this is a structure representing a perl-level coroutine */ 162/* this is a structure representing a perl-level coroutine */
147struct coro { 163struct coro {
148 /* the c coroutine allocated to this perl coroutine, if any */ 164 /* the c coroutine allocated to this perl coroutine, if any */
… …
170}; 186};
171 187
172typedef struct coro *Coro__State; 188typedef struct coro *Coro__State;
173typedef struct coro *Coro__State_or_hashref; 189typedef struct coro *Coro__State_or_hashref;
174 190
191/** Coro ********************************************************************/
192
193#define PRIO_MAX 3
194#define PRIO_HIGH 1
195#define PRIO_NORMAL 0
196#define PRIO_LOW -1
197#define PRIO_IDLE -3
198#define PRIO_MIN -4
199
200/* for Coro.pm */
201static SV *coro_current;
202static AV *coro_ready [PRIO_MAX-PRIO_MIN+1];
203static int coro_nready;
204
205/** lowlevel stuff **********************************************************/
206
175static AV * 207static AV *
176coro_clone_padlist (CV *cv) 208coro_clone_padlist (CV *cv)
177{ 209{
178 AV *padlist = CvPADLIST (cv); 210 AV *padlist = CvPADLIST (cv);
179 AV *newpadlist, *newpad; 211 AV *newpadlist, *newpad;
… …
253 285
254 if (mg && AvFILLp ((av = (AV *)mg->mg_obj)) >= 0) 286 if (mg && AvFILLp ((av = (AV *)mg->mg_obj)) >= 0)
255 CvPADLIST (cv) = (AV *)AvARRAY (av)[AvFILLp (av)--]; 287 CvPADLIST (cv) = (AV *)AvARRAY (av)[AvFILLp (av)--];
256 else 288 else
257 { 289 {
258#if 0 290#if PREFER_PERL_FUNCTIONS
259 /* this is probably cleaner, but also slower? */ 291 /* this is probably cleaner, but also slower? */
260 CV *cp = Perl_cv_clone (cv); 292 CV *cp = Perl_cv_clone (cv);
261 CvPADLIST (cv) = CvPADLIST (cp); 293 CvPADLIST (cv) = CvPADLIST (cp);
262 CvPADLIST (cp) = 0; 294 CvPADLIST (cp) = 0;
263 SvREFCNT_dec (cp); 295 SvREFCNT_dec (cp);
… …
286 if (AvFILLp (av) >= AvMAX (av)) 318 if (AvFILLp (av) >= AvMAX (av))
287 av_extend (av, AvMAX (av) + 1); 319 av_extend (av, AvMAX (av) + 1);
288 320
289 AvARRAY (av)[++AvFILLp (av)] = (SV *)CvPADLIST (cv); 321 AvARRAY (av)[++AvFILLp (av)] = (SV *)CvPADLIST (cv);
290} 322}
323
324/** load & save, init *******************************************************/
291 325
292#define SB do { 326#define SB do {
293#define SE } while (0) 327#define SE } while (0)
294 328
295#define REPLACE_SV(sv,val) SB SvREFCNT_dec (sv); (sv) = (val); (val) = 0; SE 329#define REPLACE_SV(sv,val) SB SvREFCNT_dec (sv); (sv) = (val); (val) = 0; SE
… …
344 /* 378 /*
345 * the worst thing you can imagine happens first - we have to save 379 * the worst thing you can imagine happens first - we have to save
346 * (and reinitialize) all cv's in the whole callchain :( 380 * (and reinitialize) all cv's in the whole callchain :(
347 */ 381 */
348 382
383 EXTEND (SP, 3 + 1);
349 PUSHs (Nullsv); 384 PUSHs (Nullsv);
350 /* this loop was inspired by pp_caller */ 385 /* this loop was inspired by pp_caller */
351 for (;;) 386 for (;;)
352 { 387 {
353 while (cxix >= 0) 388 while (cxix >= 0)
… …
359 CV *cv = cx->blk_sub.cv; 394 CV *cv = cx->blk_sub.cv;
360 395
361 if (CvDEPTH (cv)) 396 if (CvDEPTH (cv))
362 { 397 {
363 EXTEND (SP, 3); 398 EXTEND (SP, 3);
364
365 PUSHs ((SV *)CvPADLIST (cv)); 399 PUSHs ((SV *)CvPADLIST (cv));
366 PUSHs (INT2PTR (SV *, CvDEPTH (cv))); 400 PUSHs (INT2PTR (SV *, CvDEPTH (cv)));
367 PUSHs ((SV *)cv); 401 PUSHs ((SV *)cv);
368 402
369 CvDEPTH (cv) = 0; 403 CvDEPTH (cv) = 0;
370 get_padlist (cv); 404 get_padlist (cv);
371 } 405 }
372 } 406 }
373#ifdef CXt_FORMAT
374 else if (CxTYPE (cx) == CXt_FORMAT)
375 {
376 /* I never used formats, so how should I know how these are implemented? */
377 /* my bold guess is as a simple, plain sub... */
378 croak ("CXt_FORMAT not yet handled. Don't switch coroutines from within formats");
379 }
380#endif
381 } 407 }
382 408
383 if (top_si->si_type == PERLSI_MAIN) 409 if (top_si->si_type == PERLSI_MAIN)
384 break; 410 break;
385 411
… …
405 * allocate various perl stacks. This is an exact copy 431 * allocate various perl stacks. This is an exact copy
406 * of perl.c:init_stacks, except that it uses less memory 432 * of perl.c:init_stacks, except that it uses less memory
407 * on the (sometimes correct) assumption that coroutines do 433 * on the (sometimes correct) assumption that coroutines do
408 * not usually need a lot of stackspace. 434 * not usually need a lot of stackspace.
409 */ 435 */
436#if PREFER_PERL_FUNCTIONS
437# define coro_init_stacks init_stacks
438#else
410static void 439static void
411coro_init_stacks () 440coro_init_stacks ()
412{ 441{
413 PL_curstackinfo = new_stackinfo(128, 1024/sizeof(PERL_CONTEXT)); 442 PL_curstackinfo = new_stackinfo(128, 1024/sizeof(PERL_CONTEXT));
414 PL_curstackinfo->si_type = PERLSI_MAIN; 443 PL_curstackinfo->si_type = PERLSI_MAIN;
… …
444 New(54,PL_retstack,16,OP*); 473 New(54,PL_retstack,16,OP*);
445 PL_retstack_ix = 0; 474 PL_retstack_ix = 0;
446 PL_retstack_max = 16; 475 PL_retstack_max = 16;
447#endif 476#endif
448} 477}
478#endif
449 479
450/* 480/*
451 * destroy the stacks, the callchain etc... 481 * destroy the stacks, the callchain etc...
452 */ 482 */
453static void 483static void
454coro_destroy_stacks () 484coro_destroy_stacks ()
455{ 485{
456 if (!IN_DESTRUCT) 486 if (!IN_DESTRUCT)
457 { 487 {
458 /* is this ugly, I ask? */ 488 /* restore all saved variables and stuff */
459 LEAVE_SCOPE (0); 489 LEAVE_SCOPE (0);
490 assert (PL_tmps_floor == -1);
460 491
461 /* sure it is, but more important: is it correct?? :/ */ 492 /* free all temporaries */
462 FREETMPS; 493 FREETMPS;
494 assert (PL_tmps_ix == -1);
463 495
496 /* unwind all extra stacks */
464 /*POPSTACK_TO (PL_mainstack);*//*D*//*use*/ 497 POPSTACK_TO (PL_mainstack);
498
499 /* unwind main stack */
500 dounwind (-1);
465 } 501 }
466 502
467 while (PL_curstackinfo->si_next) 503 while (PL_curstackinfo->si_next)
468 PL_curstackinfo = PL_curstackinfo->si_next; 504 PL_curstackinfo = PL_curstackinfo->si_next;
469 505
470 while (PL_curstackinfo) 506 while (PL_curstackinfo)
471 { 507 {
472 PERL_SI *p = PL_curstackinfo->si_prev; 508 PERL_SI *p = PL_curstackinfo->si_prev;
473 509
474 { /*D*//*remove*/
475 dSP;
476 SWITCHSTACK (PL_curstack, PL_curstackinfo->si_stack);
477 PUTBACK; /* possibly superfluous */
478 }
479
480 if (!IN_DESTRUCT) 510 if (!IN_DESTRUCT)
481 {
482 dounwind (-1);/*D*//*remove*/
483 SvREFCNT_dec (PL_curstackinfo->si_stack); 511 SvREFCNT_dec (PL_curstackinfo->si_stack);
484 }
485 512
486 Safefree (PL_curstackinfo->si_cxstack); 513 Safefree (PL_curstackinfo->si_cxstack);
487 Safefree (PL_curstackinfo); 514 Safefree (PL_curstackinfo);
488 PL_curstackinfo = p; 515 PL_curstackinfo = p;
489 } 516 }
… …
494 Safefree (PL_savestack); 521 Safefree (PL_savestack);
495#if !PERL_VERSION_ATLEAST (5,9,0) 522#if !PERL_VERSION_ATLEAST (5,9,0)
496 Safefree (PL_retstack); 523 Safefree (PL_retstack);
497#endif 524#endif
498} 525}
526
527/** coroutine stack handling ************************************************/
499 528
500static void 529static void
501setup_coro (struct coro *coro) 530setup_coro (struct coro *coro)
502{ 531{
503 /* 532 /*
… …
593{ 622{
594 coro_cctx *cctx; 623 coro_cctx *cctx;
595 624
596 ++cctx_count; 625 ++cctx_count;
597 626
598 New (0, cctx, 1, coro_cctx); 627 Newz (0, cctx, 1, coro_cctx);
599 628
600#if HAVE_MMAP 629#if HAVE_MMAP
601 630
602 cctx->ssize = ((STACKSIZE * sizeof (long) + PAGESIZE - 1) / PAGESIZE + STACKGUARD) * PAGESIZE; 631 cctx->ssize = ((STACKSIZE * sizeof (long) + PAGESIZE - 1) / PAGESIZE + STACKGUARD) * PAGESIZE;
603 /* mmap supposedly does allocate-on-write for us */ 632 /* mmap supposedly does allocate-on-write for us */
… …
696 ++cctx_idle; 725 ++cctx_idle;
697 cctx->next = cctx_first; 726 cctx->next = cctx_first;
698 cctx_first = cctx; 727 cctx_first = cctx;
699} 728}
700 729
730/** coroutine switching *****************************************************/
731
701/* never call directly, always through the coro_state_transfer global variable */ 732/* never call directly, always through the coro_state_transfer global variable */
702static void NOINLINE 733static void NOINLINE
703transfer (struct coro *prev, struct coro *next) 734transfer (struct coro *prev, struct coro *next)
704{ 735{
705 dSTACKLEVEL; 736 dSTACKLEVEL;
706 737
707 /* sometimes transfer is only called to set idle_sp */ 738 /* sometimes transfer is only called to set idle_sp */
708 if (!next) 739 if (!next)
740 {
709 ((coro_cctx *)prev)->idle_sp = STACKLEVEL; 741 ((coro_cctx *)prev)->idle_sp = STACKLEVEL;
742 assert (((coro_cctx *)prev)->idle_te = PL_top_env); /* just for the side-effect when asserts are enabled */
743 }
710 else if (prev != next) 744 else if (prev != next)
711 { 745 {
712 coro_cctx *prev__cctx; 746 coro_cctx *prev__cctx;
713 747
714 if (prev->flags & CF_NEW) 748 if (prev->flags & CF_NEW)
… …
724 if (!prev->flags & CF_RUNNING) 758 if (!prev->flags & CF_RUNNING)
725 croak ("Coro::State::transfer called with non-running prev Coro::State, but can only transfer from running states"); 759 croak ("Coro::State::transfer called with non-running prev Coro::State, but can only transfer from running states");
726 760
727 if (next->flags & CF_RUNNING) 761 if (next->flags & CF_RUNNING)
728 croak ("Coro::State::transfer called with running next Coro::State, but can only transfer to inactive states"); 762 croak ("Coro::State::transfer called with running next Coro::State, but can only transfer to inactive states");
763
764 if (next->flags & CF_DESTROYED)
765 croak ("Coro::State::transfer called with destroyed next Coro::State, but can only transfer to inactive states");
729 766
730 prev->flags &= ~CF_RUNNING; 767 prev->flags &= ~CF_RUNNING;
731 next->flags |= CF_RUNNING; 768 next->flags |= CF_RUNNING;
732 769
733 LOCK; 770 LOCK;
… …
739 /* first get rid of the old state */ 776 /* first get rid of the old state */
740 save_perl (prev); 777 save_perl (prev);
741 /* setup coroutine call */ 778 /* setup coroutine call */
742 setup_coro (next); 779 setup_coro (next);
743 /* need a new stack */ 780 /* need a new stack */
744 assert (!next->stack); 781 assert (!next->cctx);
745 } 782 }
746 else 783 else
747 { 784 {
748 /* coroutine already started */ 785 /* coroutine already started */
749 save_perl (prev); 786 save_perl (prev);
… …
754 791
755 /* possibly "free" the cctx */ 792 /* possibly "free" the cctx */
756 if (prev__cctx->idle_sp == STACKLEVEL) 793 if (prev__cctx->idle_sp == STACKLEVEL)
757 { 794 {
758 /* I assume that STACKLEVEL is a stronger indicator than PL_top_env changes */ 795 /* I assume that STACKLEVEL is a stronger indicator than PL_top_env changes */
759 assert (PL_top_env == prev__cctx->top_env); 796 assert (("ERROR: current top_env must equal previous top_env", PL_top_env == prev__cctx->idle_te));
760 797
761 prev->cctx = 0; 798 prev->cctx = 0;
762 799
763 cctx_put (prev__cctx); 800 cctx_put (prev__cctx);
764 prev__cctx->inuse = 0; 801 prev__cctx->inuse = 0;
… …
777 PL_top_env = next->cctx->top_env; 814 PL_top_env = next->cctx->top_env;
778 coro_transfer (&prev__cctx->cctx, &next->cctx->cctx); 815 coro_transfer (&prev__cctx->cctx, &next->cctx->cctx);
779 } 816 }
780 817
781 free_coro_mortal (); 818 free_coro_mortal ();
782
783 UNLOCK; 819 UNLOCK;
784 } 820 }
785} 821}
786 822
787struct transfer_args 823struct transfer_args
… …
789 struct coro *prev, *next; 825 struct coro *prev, *next;
790}; 826};
791 827
792#define TRANSFER(ta) transfer ((ta).prev, (ta).next) 828#define TRANSFER(ta) transfer ((ta).prev, (ta).next)
793 829
830/** high level stuff ********************************************************/
831
794static void 832static int
795coro_state_destroy (struct coro *coro) 833coro_state_destroy (struct coro *coro)
796{ 834{
797 if (coro->refcnt--) 835 if (coro->flags & CF_DESTROYED)
798 return; 836 return 0;
837
838 coro->flags |= CF_DESTROYED;
839
840 if (coro->flags & CF_READY)
841 {
842 /* reduce nready, as destroying a ready coro effectively unreadies it */
843 /* alternative: look through all ready queues and remove it */
844 LOCK;
845 --coro_nready;
846 UNLOCK;
847 }
848 else
849 coro->flags |= CF_READY; /* make sure it is NOT put into the readyqueue */
799 850
800 if (coro->mainstack && coro->mainstack != main_mainstack) 851 if (coro->mainstack && coro->mainstack != main_mainstack)
801 { 852 {
853 assert (!(coro->flags & CF_RUNNING));
854
802 struct coro temp; 855 struct coro temp;
803 Zero (&temp, 1, struct coro); 856 Zero (&temp, 1, struct coro);
804 temp.save = CORO_SAVE_ALL; 857 temp.save = CORO_SAVE_ALL;
805 858
806 if (coro->flags & CF_RUNNING) 859 if (coro->flags & CF_RUNNING)
… …
816 coro->mainstack = 0; 869 coro->mainstack = 0;
817 } 870 }
818 871
819 cctx_destroy (coro->cctx); 872 cctx_destroy (coro->cctx);
820 SvREFCNT_dec (coro->args); 873 SvREFCNT_dec (coro->args);
821 Safefree (coro); 874
875 return 1;
822} 876}
823 877
824static int 878static int
825coro_state_clear (pTHX_ SV *sv, MAGIC *mg) 879coro_state_free (pTHX_ SV *sv, MAGIC *mg)
826{ 880{
827 struct coro *coro = (struct coro *)mg->mg_ptr; 881 struct coro *coro = (struct coro *)mg->mg_ptr;
828 mg->mg_ptr = 0; 882 mg->mg_ptr = 0;
829 883
884 if (--coro->refcnt < 0)
885 {
830 coro_state_destroy (coro); 886 coro_state_destroy (coro);
887 Safefree (coro);
888 }
831 889
832 return 0; 890 return 0;
833} 891}
834 892
835static int 893static int
… …
842 return 0; 900 return 0;
843} 901}
844 902
845static MGVTBL coro_state_vtbl = { 903static MGVTBL coro_state_vtbl = {
846 0, 0, 0, 0, 904 0, 0, 0, 0,
847 coro_state_clear, 905 coro_state_free,
848 0, 906 0,
849#ifdef MGf_DUP 907#ifdef MGf_DUP
850 coro_state_dup, 908 coro_state_dup,
851#else 909#else
852# define MGf_DUP 0 910# define MGf_DUP 0
… …
903 return old_save; 961 return old_save;
904} 962}
905 963
906/** Coro ********************************************************************/ 964/** Coro ********************************************************************/
907 965
908#define PRIO_MAX 3
909#define PRIO_HIGH 1
910#define PRIO_NORMAL 0
911#define PRIO_LOW -1
912#define PRIO_IDLE -3
913#define PRIO_MIN -4
914
915/* for Coro.pm */
916static SV *coro_current;
917static AV *coro_ready [PRIO_MAX-PRIO_MIN+1];
918static int coro_nready;
919
920static void 966static void
921coro_enq (SV *coro_sv) 967coro_enq (SV *coro_sv)
922{ 968{
923 av_push (coro_ready [SvSTATE (coro_sv)->prio - PRIO_MIN], coro_sv); 969 av_push (coro_ready [SvSTATE (coro_sv)->prio - PRIO_MIN], coro_sv);
924 coro_nready++;
925} 970}
926 971
927static SV * 972static SV *
928coro_deq (int min_prio) 973coro_deq (int min_prio)
929{ 974{
… …
933 if (min_prio < 0) 978 if (min_prio < 0)
934 min_prio = 0; 979 min_prio = 0;
935 980
936 for (prio = PRIO_MAX - PRIO_MIN + 1; --prio >= min_prio; ) 981 for (prio = PRIO_MAX - PRIO_MIN + 1; --prio >= min_prio; )
937 if (AvFILLp (coro_ready [prio]) >= 0) 982 if (AvFILLp (coro_ready [prio]) >= 0)
938 {
939 coro_nready--;
940 return av_shift (coro_ready [prio]); 983 return av_shift (coro_ready [prio]);
941 }
942 984
943 return 0; 985 return 0;
944} 986}
945 987
946static int 988static int
… …
954 coro = SvSTATE (coro_sv); 996 coro = SvSTATE (coro_sv);
955 997
956 if (coro->flags & CF_READY) 998 if (coro->flags & CF_READY)
957 return 0; 999 return 0;
958 1000
959#if 0 /* this is actually harmless */
960 if (coro->flags & CF_RUNNING)
961 croak ("Coro::ready called on currently running coroutine");
962#endif
963
964 coro->flags |= CF_READY; 1001 coro->flags |= CF_READY;
965 1002
966 LOCK; 1003 LOCK;
967 coro_enq (SvREFCNT_inc (coro_sv)); 1004 coro_enq (SvREFCNT_inc (coro_sv));
1005 ++coro_nready;
968 UNLOCK; 1006 UNLOCK;
969 1007
970 return 1; 1008 return 1;
971} 1009}
972 1010
973static int 1011static int
974api_is_ready (SV *coro_sv) 1012api_is_ready (SV *coro_sv)
975{ 1013{
976 return !!SvSTATE (coro_sv)->flags & CF_READY; 1014 return !!(SvSTATE (coro_sv)->flags & CF_READY);
977} 1015}
978 1016
979static void 1017static void
980prepare_schedule (struct transfer_args *ta) 1018prepare_schedule (struct transfer_args *ta)
981{ 1019{
982 SV *prev, *next; 1020 SV *prev_sv, *next_sv;
983 1021
984 for (;;) 1022 for (;;)
985 { 1023 {
986 LOCK; 1024 LOCK;
987 next = coro_deq (PRIO_MIN); 1025 next_sv = coro_deq (PRIO_MIN);
1026
1027 /* nothing to schedule: call the idle handler */
1028 if (!next_sv)
1029 {
1030 UNLOCK;
1031 dSP;
1032
1033 ENTER;
1034 SAVETMPS;
1035
1036 PUSHMARK (SP);
1037 PUTBACK;
1038 call_sv (get_sv ("Coro::idle", FALSE), G_DISCARD);
1039
1040 FREETMPS;
1041 LEAVE;
1042 continue;
1043 }
1044
1045 ta->next = SvSTATE (next_sv);
1046
1047 /* cannot transfer to destroyed coros, skip and look for next */
1048 if (ta->next->flags & CF_DESTROYED)
1049 {
1050 UNLOCK;
1051 SvREFCNT_dec (next_sv);
1052 /* coro_nready is already taken care of by destroy */
1053 continue;
1054 }
1055
1056 --coro_nready;
988 UNLOCK; 1057 UNLOCK;
989
990 if (next)
991 break; 1058 break;
992
993 {
994 dSP;
995
996 ENTER;
997 SAVETMPS;
998
999 PUSHMARK (SP);
1000 PUTBACK;
1001 call_sv (get_sv ("Coro::idle", FALSE), G_DISCARD);
1002
1003 FREETMPS;
1004 LEAVE;
1005 } 1059 }
1006 }
1007
1008 prev = SvRV (coro_current);
1009 SvRV_set (coro_current, next);
1010 1060
1011 /* free this only after the transfer */ 1061 /* free this only after the transfer */
1062 prev_sv = SvRV (coro_current);
1063 SvRV_set (coro_current, next_sv);
1064 ta->prev = SvSTATE (prev_sv);
1065
1066 assert (ta->next->flags & CF_READY);
1067 ta->next->flags &= ~CF_READY;
1068
1012 LOCK; 1069 LOCK;
1013 free_coro_mortal (); 1070 free_coro_mortal ();
1071 coro_mortal = prev_sv;
1014 UNLOCK; 1072 UNLOCK;
1015 coro_mortal = prev;
1016
1017 assert (!SvROK(prev));//D
1018 assert (!SvROK(next));//D
1019
1020 ta->prev = SvSTATE (prev);
1021 ta->next = SvSTATE (next);
1022
1023 assert (ta->next->flags & CF_READY);
1024 ta->next->flags &= ~CF_READY;
1025} 1073}
1026 1074
1027static void 1075static void
1028prepare_cede (struct transfer_args *ta) 1076prepare_cede (struct transfer_args *ta)
1029{ 1077{
1030 api_ready (coro_current); 1078 api_ready (coro_current);
1031
1032 prepare_schedule (ta); 1079 prepare_schedule (ta);
1080}
1081
1082static int
1083prepare_cede_notself (struct transfer_args *ta)
1084{
1085 if (coro_nready)
1086 {
1087 SV *prev = SvRV (coro_current);
1088 prepare_schedule (ta);
1089 api_ready (prev);
1090 return 1;
1091 }
1092 else
1093 return 0;
1033} 1094}
1034 1095
1035static void 1096static void
1036api_schedule (void) 1097api_schedule (void)
1037{ 1098{
… …
1039 1100
1040 prepare_schedule (&ta); 1101 prepare_schedule (&ta);
1041 TRANSFER (ta); 1102 TRANSFER (ta);
1042} 1103}
1043 1104
1044static void 1105static int
1045api_cede (void) 1106api_cede (void)
1046{ 1107{
1047 struct transfer_args ta; 1108 struct transfer_args ta;
1048 1109
1049 prepare_cede (&ta); 1110 prepare_cede (&ta);
1111
1112 if (ta.prev != ta.next)
1113 {
1050 TRANSFER (ta); 1114 TRANSFER (ta);
1115 return 1;
1116 }
1117 else
1118 return 0;
1119}
1120
1121static int
1122api_cede_notself (void)
1123{
1124 struct transfer_args ta;
1125
1126 if (prepare_cede_notself (&ta))
1127 {
1128 TRANSFER (ta);
1129 return 1;
1130 }
1131 else
1132 return 0;
1051} 1133}
1052 1134
1053MODULE = Coro::State PACKAGE = Coro::State 1135MODULE = Coro::State PACKAGE = Coro::State
1054 1136
1055PROTOTYPES: DISABLE 1137PROTOTYPES: DISABLE
… …
1111_set_stacklevel (...) 1193_set_stacklevel (...)
1112 ALIAS: 1194 ALIAS:
1113 Coro::State::transfer = 1 1195 Coro::State::transfer = 1
1114 Coro::schedule = 2 1196 Coro::schedule = 2
1115 Coro::cede = 3 1197 Coro::cede = 3
1198 Coro::cede_notself = 4
1116 CODE: 1199 CODE:
1117{ 1200{
1118 struct transfer_args ta; 1201 struct transfer_args ta;
1119 1202
1120 switch (ix) 1203 switch (ix)
… …
1136 break; 1219 break;
1137 1220
1138 case 3: 1221 case 3:
1139 prepare_cede (&ta); 1222 prepare_cede (&ta);
1140 break; 1223 break;
1224
1225 case 4:
1226 if (!prepare_cede_notself (&ta))
1227 XSRETURN_EMPTY;
1228
1229 break;
1141 } 1230 }
1142 1231
1232 BARRIER;
1143 TRANSFER (ta); 1233 TRANSFER (ta);
1144}
1145 1234
1146void 1235 if (GIMME_V != G_VOID && ta.next != ta.prev)
1147_clone_state_from (SV *dst, SV *src) 1236 XSRETURN_YES;
1237}
1238
1239bool
1240_destroy (SV *coro_sv)
1148 CODE: 1241 CODE:
1149{ 1242 RETVAL = coro_state_destroy (SvSTATE (coro_sv));
1150 struct coro *coro_src = SvSTATE (src); 1243 OUTPUT:
1151 1244 RETVAL
1152 sv_unmagic (SvRV (dst), PERL_MAGIC_ext);
1153
1154 ++coro_src->refcnt;
1155 sv_magicext (SvRV (dst), 0, PERL_MAGIC_ext, &coro_state_vtbl, (char *)coro_src, 0)->mg_flags |= MGf_DUP;
1156}
1157 1245
1158void 1246void
1159_exit (code) 1247_exit (code)
1160 int code 1248 int code
1161 PROTOTYPE: $ 1249 PROTOTYPE: $
… …
1198 coro_ready[i] = newAV (); 1286 coro_ready[i] = newAV ();
1199 1287
1200 { 1288 {
1201 SV *sv = perl_get_sv("Coro::API", 1); 1289 SV *sv = perl_get_sv("Coro::API", 1);
1202 1290
1203 coroapi.schedule = api_schedule; 1291 coroapi.schedule = api_schedule;
1204 coroapi.save = api_save; 1292 coroapi.save = api_save;
1205 coroapi.cede = api_cede; 1293 coroapi.cede = api_cede;
1294 coroapi.cede_notself = api_cede_notself;
1206 coroapi.ready = api_ready; 1295 coroapi.ready = api_ready;
1207 coroapi.is_ready = api_is_ready; 1296 coroapi.is_ready = api_is_ready;
1208 coroapi.nready = &coro_nready; 1297 coroapi.nready = &coro_nready;
1209 coroapi.current = coro_current; 1298 coroapi.current = coro_current;
1210 1299
1211 GCoroAPI = &coroapi; 1300 GCoroAPI = &coroapi;
1212 sv_setiv (sv, (IV)&coroapi); 1301 sv_setiv (sv, (IV)&coroapi);
1213 SvREADONLY_on (sv); 1302 SvREADONLY_on (sv);
1214 } 1303 }
… …
1230 RETVAL = coro->prio; 1319 RETVAL = coro->prio;
1231 1320
1232 if (items > 1) 1321 if (items > 1)
1233 { 1322 {
1234 if (ix) 1323 if (ix)
1235 newprio += coro->prio; 1324 newprio = coro->prio - newprio;
1236 1325
1237 if (newprio < PRIO_MIN) newprio = PRIO_MIN; 1326 if (newprio < PRIO_MIN) newprio = PRIO_MIN;
1238 if (newprio > PRIO_MAX) newprio = PRIO_MAX; 1327 if (newprio > PRIO_MAX) newprio = PRIO_MAX;
1239 1328
1240 coro->prio = newprio; 1329 coro->prio = newprio;
1241 } 1330 }
1242} 1331}
1332 OUTPUT:
1333 RETVAL
1243 1334
1244SV * 1335SV *
1245ready (SV *self) 1336ready (SV *self)
1246 PROTOTYPE: $ 1337 PROTOTYPE: $
1247 CODE: 1338 CODE:

Diff Legend

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