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.125 by root, Mon Dec 11 20:54:45 2006 UTC vs.
Revision 1.135 by root, Fri Jan 5 18:25:51 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/* 5.8.7 */
44#ifndef SvRV_set
45# define SvRV_set(s,v) SvRV(s) = (v)
46#endif
47
48#include <stdio.h> 9#include <stdio.h>
49#include <errno.h> 10#include <errno.h>
50#include <assert.h> 11#include <assert.h>
51
52#if !__i386 && !__x86_64 && !__powerpc && !__m68k && !__alpha && !__mips && !__sparc64
53# undef STACKGUARD
54#endif
55
56#ifndef STACKGUARD
57# define STACKGUARD 0
58#endif
59 12
60#ifdef HAVE_MMAP 13#ifdef HAVE_MMAP
61# include <unistd.h> 14# include <unistd.h>
62# include <sys/mman.h> 15# include <sys/mman.h>
63# ifndef MAP_ANONYMOUS 16# ifndef MAP_ANONYMOUS
… …
78#else 31#else
79# define PAGESIZE 0 32# define PAGESIZE 0
80# define BOOT_PAGESIZE (void)0 33# define BOOT_PAGESIZE (void)0
81#endif 34#endif
82 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
83/* 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
84 * 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
85 * and should be unique. */ 90 * and should be unique. */
86#define dSTACKLEVEL int stacklevel 91#define dSTACKLEVEL int stacklevel
87#define STACKLEVEL ((void *)&stacklevel) 92#define STACKLEVEL ((void *)&stacklevel)
88 93
89#define IN_DESTRUCT (PL_main_cv == Nullcv) 94#define IN_DESTRUCT (PL_main_cv == Nullcv)
90 95
91#if __GNUC__ >= 3 96#if __GNUC__ >= 3
92# define attribute(x) __attribute__(x) 97# define attribute(x) __attribute__(x)
98# define BARRIER __asm__ __volatile__ ("" : : : "memory")
93#else 99#else
94# define attribute(x) 100# define attribute(x)
101# define BARRIER
95#endif 102#endif
96 103
97#define NOINLINE attribute ((noinline)) 104#define NOINLINE attribute ((noinline))
98 105
99#include "CoroAPI.h" 106#include "CoroAPI.h"
… …
130 /* the stack */ 137 /* the stack */
131 void *sptr; 138 void *sptr;
132 long ssize; /* positive == mmap, otherwise malloc */ 139 long ssize; /* positive == mmap, otherwise malloc */
133 140
134 /* cpu state */ 141 /* cpu state */
135 void *idle_sp; /* sp of top-level transfer/schedule/cede call */ 142 void *idle_sp; /* sp of top-level transfer/schedule/cede call */
143 JMPENV *idle_te; /* same as idle_sp, but for top_env, TODO: remove once stable */
136 JMPENV *top_env; 144 JMPENV *top_env;
137 coro_context cctx; 145 coro_context cctx;
138 146
139 int inuse; 147 int inuse;
140 148
… …
142 int valgrind_id; 150 int valgrind_id;
143#endif 151#endif
144} coro_cctx; 152} coro_cctx;
145 153
146enum { 154enum {
147 CF_RUNNING = 0x0001, /* coroutine is running */ 155 CF_RUNNING = 0x0001, /* coroutine is running */
148 CF_READY = 0x0002, /* coroutine is ready */ 156 CF_READY = 0x0002, /* coroutine is ready */
149 CF_NEW = 0x0004, /* ahs never been switched to */ 157 CF_NEW = 0x0004, /* has never been switched to */
158 CF_DESTROYED = 0x0008, /* coroutine data has been freed */
150}; 159};
151 160
152/* this is a structure representing a perl-level coroutine */ 161/* this is a structure representing a perl-level coroutine */
153struct coro { 162struct coro {
154 /* the c coroutine allocated to this perl coroutine, if any */ 163 /* the c coroutine allocated to this perl coroutine, if any */
… …
259 268
260 if (mg && AvFILLp ((av = (AV *)mg->mg_obj)) >= 0) 269 if (mg && AvFILLp ((av = (AV *)mg->mg_obj)) >= 0)
261 CvPADLIST (cv) = (AV *)AvARRAY (av)[AvFILLp (av)--]; 270 CvPADLIST (cv) = (AV *)AvARRAY (av)[AvFILLp (av)--];
262 else 271 else
263 { 272 {
264#if 0 273#if PREFER_PERL_FUNCTIONS
265 /* this is probably cleaner, but also slower? */ 274 /* this is probably cleaner, but also slower? */
266 CV *cp = Perl_cv_clone (cv); 275 CV *cp = Perl_cv_clone (cv);
267 CvPADLIST (cv) = CvPADLIST (cp); 276 CvPADLIST (cv) = CvPADLIST (cp);
268 CvPADLIST (cp) = 0; 277 CvPADLIST (cp) = 0;
269 SvREFCNT_dec (cp); 278 SvREFCNT_dec (cp);
… …
350 /* 359 /*
351 * the worst thing you can imagine happens first - we have to save 360 * the worst thing you can imagine happens first - we have to save
352 * (and reinitialize) all cv's in the whole callchain :( 361 * (and reinitialize) all cv's in the whole callchain :(
353 */ 362 */
354 363
364 EXTEND (SP, 3 + 1);
355 PUSHs (Nullsv); 365 PUSHs (Nullsv);
356 /* this loop was inspired by pp_caller */ 366 /* this loop was inspired by pp_caller */
357 for (;;) 367 for (;;)
358 { 368 {
359 while (cxix >= 0) 369 while (cxix >= 0)
… …
365 CV *cv = cx->blk_sub.cv; 375 CV *cv = cx->blk_sub.cv;
366 376
367 if (CvDEPTH (cv)) 377 if (CvDEPTH (cv))
368 { 378 {
369 EXTEND (SP, 3); 379 EXTEND (SP, 3);
370
371 PUSHs ((SV *)CvPADLIST (cv)); 380 PUSHs ((SV *)CvPADLIST (cv));
372 PUSHs (INT2PTR (SV *, CvDEPTH (cv))); 381 PUSHs (INT2PTR (SV *, CvDEPTH (cv)));
373 PUSHs ((SV *)cv); 382 PUSHs ((SV *)cv);
374 383
375 CvDEPTH (cv) = 0; 384 CvDEPTH (cv) = 0;
376 get_padlist (cv); 385 get_padlist (cv);
377 } 386 }
378 } 387 }
379#ifdef CXt_FORMAT
380 else if (CxTYPE (cx) == CXt_FORMAT)
381 {
382 /* I never used formats, so how should I know how these are implemented? */
383 /* my bold guess is as a simple, plain sub... */
384 croak ("CXt_FORMAT not yet handled. Don't switch coroutines from within formats");
385 }
386#endif
387 } 388 }
388 389
389 if (top_si->si_type == PERLSI_MAIN) 390 if (top_si->si_type == PERLSI_MAIN)
390 break; 391 break;
391 392
… …
411 * allocate various perl stacks. This is an exact copy 412 * allocate various perl stacks. This is an exact copy
412 * of perl.c:init_stacks, except that it uses less memory 413 * of perl.c:init_stacks, except that it uses less memory
413 * on the (sometimes correct) assumption that coroutines do 414 * on the (sometimes correct) assumption that coroutines do
414 * not usually need a lot of stackspace. 415 * not usually need a lot of stackspace.
415 */ 416 */
417#if PREFER_PERL_FUNCTIONS
418# define coro_init_stacks init_stacks
419#else
416static void 420static void
417coro_init_stacks () 421coro_init_stacks ()
418{ 422{
419 PL_curstackinfo = new_stackinfo(128, 1024/sizeof(PERL_CONTEXT)); 423 PL_curstackinfo = new_stackinfo(128, 1024/sizeof(PERL_CONTEXT));
420 PL_curstackinfo->si_type = PERLSI_MAIN; 424 PL_curstackinfo->si_type = PERLSI_MAIN;
… …
450 New(54,PL_retstack,16,OP*); 454 New(54,PL_retstack,16,OP*);
451 PL_retstack_ix = 0; 455 PL_retstack_ix = 0;
452 PL_retstack_max = 16; 456 PL_retstack_max = 16;
453#endif 457#endif
454} 458}
459#endif
455 460
456/* 461/*
457 * destroy the stacks, the callchain etc... 462 * destroy the stacks, the callchain etc...
458 */ 463 */
459static void 464static void
460coro_destroy_stacks () 465coro_destroy_stacks ()
461{ 466{
462 if (!IN_DESTRUCT) 467 if (!IN_DESTRUCT)
463 { 468 {
464 /* is this ugly, I ask? */ 469 /* restore all saved variables and stuff */
465 LEAVE_SCOPE (0); 470 LEAVE_SCOPE (0);
471 assert (PL_tmps_floor == -1);
466 472
467 /* sure it is, but more important: is it correct?? :/ */ 473 /* free all temporaries */
468 FREETMPS; 474 FREETMPS;
475 assert (PL_tmps_ix == -1);
469 476
477 /* unwind all extra stacks */
470 /*POPSTACK_TO (PL_mainstack);*//*D*//*use*/ 478 POPSTACK_TO (PL_mainstack);
479
480 /* unwind main stack */
481 dounwind (-1);
471 } 482 }
472 483
473 while (PL_curstackinfo->si_next) 484 while (PL_curstackinfo->si_next)
474 PL_curstackinfo = PL_curstackinfo->si_next; 485 PL_curstackinfo = PL_curstackinfo->si_next;
475 486
476 while (PL_curstackinfo) 487 while (PL_curstackinfo)
477 { 488 {
478 PERL_SI *p = PL_curstackinfo->si_prev; 489 PERL_SI *p = PL_curstackinfo->si_prev;
479 490
480 { /*D*//*remove*/
481 dSP;
482 SWITCHSTACK (PL_curstack, PL_curstackinfo->si_stack);
483 PUTBACK; /* possibly superfluous */
484 }
485
486 if (!IN_DESTRUCT) 491 if (!IN_DESTRUCT)
487 {
488 dounwind (-1);/*D*//*remove*/
489 SvREFCNT_dec (PL_curstackinfo->si_stack); 492 SvREFCNT_dec (PL_curstackinfo->si_stack);
490 }
491 493
492 Safefree (PL_curstackinfo->si_cxstack); 494 Safefree (PL_curstackinfo->si_cxstack);
493 Safefree (PL_curstackinfo); 495 Safefree (PL_curstackinfo);
494 PL_curstackinfo = p; 496 PL_curstackinfo = p;
495 } 497 }
… …
712 714
713 /* sometimes transfer is only called to set idle_sp */ 715 /* sometimes transfer is only called to set idle_sp */
714 if (!next) 716 if (!next)
715 { 717 {
716 ((coro_cctx *)prev)->idle_sp = STACKLEVEL; 718 ((coro_cctx *)prev)->idle_sp = STACKLEVEL;
717 assert (((coro_cctx *)prev)->top_env = PL_top_env); /* just for the side effetc when assert is enabled */ 719 assert (((coro_cctx *)prev)->idle_te = PL_top_env); /* just for the side-effect when asserts are enabled */
718 } 720 }
719 else if (prev != next) 721 else if (prev != next)
720 { 722 {
721 coro_cctx *prev__cctx; 723 coro_cctx *prev__cctx;
722 724
… …
733 if (!prev->flags & CF_RUNNING) 735 if (!prev->flags & CF_RUNNING)
734 croak ("Coro::State::transfer called with non-running prev Coro::State, but can only transfer from running states"); 736 croak ("Coro::State::transfer called with non-running prev Coro::State, but can only transfer from running states");
735 737
736 if (next->flags & CF_RUNNING) 738 if (next->flags & CF_RUNNING)
737 croak ("Coro::State::transfer called with running next Coro::State, but can only transfer to inactive states"); 739 croak ("Coro::State::transfer called with running next Coro::State, but can only transfer to inactive states");
740
741 if (next->flags & CF_DESTROYED)
742 croak ("Coro::State::transfer called with destroyed next Coro::State, but can only transfer to inactive states");
738 743
739 prev->flags &= ~CF_RUNNING; 744 prev->flags &= ~CF_RUNNING;
740 next->flags |= CF_RUNNING; 745 next->flags |= CF_RUNNING;
741 746
742 LOCK; 747 LOCK;
… …
763 768
764 /* possibly "free" the cctx */ 769 /* possibly "free" the cctx */
765 if (prev__cctx->idle_sp == STACKLEVEL) 770 if (prev__cctx->idle_sp == STACKLEVEL)
766 { 771 {
767 /* I assume that STACKLEVEL is a stronger indicator than PL_top_env changes */ 772 /* I assume that STACKLEVEL is a stronger indicator than PL_top_env changes */
768 assert (PL_top_env == prev__cctx->top_env); 773 assert (("ERROR: current top_env must equal previous top_env", PL_top_env == prev__cctx->idle_te));
769 774
770 prev->cctx = 0; 775 prev->cctx = 0;
771 776
772 cctx_put (prev__cctx); 777 cctx_put (prev__cctx);
773 prev__cctx->inuse = 0; 778 prev__cctx->inuse = 0;
… …
786 PL_top_env = next->cctx->top_env; 791 PL_top_env = next->cctx->top_env;
787 coro_transfer (&prev__cctx->cctx, &next->cctx->cctx); 792 coro_transfer (&prev__cctx->cctx, &next->cctx->cctx);
788 } 793 }
789 794
790 free_coro_mortal (); 795 free_coro_mortal ();
791
792 UNLOCK; 796 UNLOCK;
793 } 797 }
794} 798}
795 799
796struct transfer_args 800struct transfer_args
… …
798 struct coro *prev, *next; 802 struct coro *prev, *next;
799}; 803};
800 804
801#define TRANSFER(ta) transfer ((ta).prev, (ta).next) 805#define TRANSFER(ta) transfer ((ta).prev, (ta).next)
802 806
803static void 807static int
804coro_state_destroy (struct coro *coro) 808coro_state_destroy (struct coro *coro)
805{ 809{
806 if (coro->refcnt--) 810 if (coro->flags & CF_DESTROYED)
807 return; 811 return 0;
812
813 coro->flags |= CF_DESTROYED;
808 814
809 if (coro->mainstack && coro->mainstack != main_mainstack) 815 if (coro->mainstack && coro->mainstack != main_mainstack)
810 { 816 {
817 assert (!(coro->flags & CF_RUNNING));
818
811 struct coro temp; 819 struct coro temp;
812 Zero (&temp, 1, struct coro); 820 Zero (&temp, 1, struct coro);
813 temp.save = CORO_SAVE_ALL; 821 temp.save = CORO_SAVE_ALL;
814 822
815 if (coro->flags & CF_RUNNING) 823 if (coro->flags & CF_RUNNING)
… …
825 coro->mainstack = 0; 833 coro->mainstack = 0;
826 } 834 }
827 835
828 cctx_destroy (coro->cctx); 836 cctx_destroy (coro->cctx);
829 SvREFCNT_dec (coro->args); 837 SvREFCNT_dec (coro->args);
830 Safefree (coro); 838
839 return 1;
831} 840}
832 841
833static int 842static int
834coro_state_clear (pTHX_ SV *sv, MAGIC *mg) 843coro_state_free (pTHX_ SV *sv, MAGIC *mg)
835{ 844{
836 struct coro *coro = (struct coro *)mg->mg_ptr; 845 struct coro *coro = (struct coro *)mg->mg_ptr;
837 mg->mg_ptr = 0; 846 mg->mg_ptr = 0;
838 847
848 if (--coro->refcnt < 0)
849 {
839 coro_state_destroy (coro); 850 coro_state_destroy (coro);
851 Safefree (coro);
852 }
840 853
841 return 0; 854 return 0;
842} 855}
843 856
844static int 857static int
… …
851 return 0; 864 return 0;
852} 865}
853 866
854static MGVTBL coro_state_vtbl = { 867static MGVTBL coro_state_vtbl = {
855 0, 0, 0, 0, 868 0, 0, 0, 0,
856 coro_state_clear, 869 coro_state_free,
857 0, 870 0,
858#ifdef MGf_DUP 871#ifdef MGf_DUP
859 coro_state_dup, 872 coro_state_dup,
860#else 873#else
861# define MGf_DUP 0 874# define MGf_DUP 0
… …
963 coro = SvSTATE (coro_sv); 976 coro = SvSTATE (coro_sv);
964 977
965 if (coro->flags & CF_READY) 978 if (coro->flags & CF_READY)
966 return 0; 979 return 0;
967 980
968#if 0 /* this is actually harmless */
969 if (coro->flags & CF_RUNNING)
970 croak ("Coro::ready called on currently running coroutine");
971#endif
972
973 coro->flags |= CF_READY; 981 coro->flags |= CF_READY;
974 982
975 LOCK; 983 LOCK;
976 coro_enq (SvREFCNT_inc (coro_sv)); 984 coro_enq (SvREFCNT_inc (coro_sv));
977 UNLOCK; 985 UNLOCK;
… …
980} 988}
981 989
982static int 990static int
983api_is_ready (SV *coro_sv) 991api_is_ready (SV *coro_sv)
984{ 992{
985 return !!SvSTATE (coro_sv)->flags & CF_READY; 993 return !!(SvSTATE (coro_sv)->flags & CF_READY);
986} 994}
987 995
988static void 996static void
989prepare_schedule (struct transfer_args *ta) 997prepare_schedule (struct transfer_args *ta)
990{ 998{
991 SV *prev, *next; 999 SV *prev_sv, *next_sv;
992 1000
993 for (;;) 1001 for (;;)
994 { 1002 {
995 LOCK; 1003 LOCK;
996 next = coro_deq (PRIO_MIN); 1004 next_sv = coro_deq (PRIO_MIN);
997 UNLOCK; 1005 UNLOCK;
998 1006
1007 /* nothing to schedule: call the idle handler */
999 if (next) 1008 if (!next_sv)
1000 break;
1001
1002 { 1009 {
1003 dSP; 1010 dSP;
1004 1011
1005 ENTER; 1012 ENTER;
1006 SAVETMPS; 1013 SAVETMPS;
1007 1014
1008 PUSHMARK (SP); 1015 PUSHMARK (SP);
1009 PUTBACK; 1016 PUTBACK;
1010 call_sv (get_sv ("Coro::idle", FALSE), G_DISCARD); 1017 call_sv (get_sv ("Coro::idle", FALSE), G_DISCARD);
1011 1018
1012 FREETMPS; 1019 FREETMPS;
1013 LEAVE; 1020 LEAVE;
1021 continue;
1014 } 1022 }
1015 }
1016 1023
1017 prev = SvRV (coro_current); 1024 ta->next = SvSTATE (next_sv);
1018 SvRV_set (coro_current, next); 1025
1026 /* cannot transfer to destroyed coros, skip and look for next */
1027 if (ta->next->flags & CF_DESTROYED)
1028 {
1029 SvREFCNT_dec (next_sv);
1030 continue;
1031 }
1032
1033 break;
1034 }
1019 1035
1020 /* free this only after the transfer */ 1036 /* free this only after the transfer */
1037 prev_sv = SvRV (coro_current);
1038 SvRV_set (coro_current, next_sv);
1039 ta->prev = SvSTATE (prev_sv);
1040
1041 assert (ta->next->flags & CF_READY);
1042 ta->next->flags &= ~CF_READY;
1043
1021 LOCK; 1044 LOCK;
1022 free_coro_mortal (); 1045 free_coro_mortal ();
1046 coro_mortal = prev_sv;
1023 UNLOCK; 1047 UNLOCK;
1024 coro_mortal = prev;
1025
1026 assert (!SvROK(prev));//D
1027 assert (!SvROK(next));//D
1028
1029 ta->prev = SvSTATE (prev);
1030 ta->next = SvSTATE (next);
1031
1032 assert (ta->next->flags & CF_READY);
1033 ta->next->flags &= ~CF_READY;
1034} 1048}
1035 1049
1036static void 1050static void
1037prepare_cede (struct transfer_args *ta) 1051prepare_cede (struct transfer_args *ta)
1038{ 1052{
1039 api_ready (coro_current); 1053 api_ready (coro_current);
1040
1041 prepare_schedule (ta); 1054 prepare_schedule (ta);
1055}
1056
1057static int
1058prepare_cede_notself (struct transfer_args *ta)
1059{
1060 if (coro_nready)
1061 {
1062 SV *prev = SvRV (coro_current);
1063 prepare_schedule (ta);
1064 api_ready (prev);
1065 return 1;
1066 }
1067 else
1068 return 0;
1042} 1069}
1043 1070
1044static void 1071static void
1045api_schedule (void) 1072api_schedule (void)
1046{ 1073{
… …
1048 1075
1049 prepare_schedule (&ta); 1076 prepare_schedule (&ta);
1050 TRANSFER (ta); 1077 TRANSFER (ta);
1051} 1078}
1052 1079
1053static void 1080static int
1054api_cede (void) 1081api_cede (void)
1055{ 1082{
1056 struct transfer_args ta; 1083 struct transfer_args ta;
1057 1084
1058 prepare_cede (&ta); 1085 prepare_cede (&ta);
1086
1087 if (ta.prev != ta.next)
1088 {
1059 TRANSFER (ta); 1089 TRANSFER (ta);
1090 return 1;
1091 }
1092 else
1093 return 0;
1094}
1095
1096static int
1097api_cede_notself (void)
1098{
1099 struct transfer_args ta;
1100
1101 if (prepare_cede_notself (&ta))
1102 {
1103 TRANSFER (ta);
1104 return 1;
1105 }
1106 else
1107 return 0;
1060} 1108}
1061 1109
1062MODULE = Coro::State PACKAGE = Coro::State 1110MODULE = Coro::State PACKAGE = Coro::State
1063 1111
1064PROTOTYPES: DISABLE 1112PROTOTYPES: DISABLE
… …
1120_set_stacklevel (...) 1168_set_stacklevel (...)
1121 ALIAS: 1169 ALIAS:
1122 Coro::State::transfer = 1 1170 Coro::State::transfer = 1
1123 Coro::schedule = 2 1171 Coro::schedule = 2
1124 Coro::cede = 3 1172 Coro::cede = 3
1173 Coro::cede_notself = 4
1125 CODE: 1174 CODE:
1126{ 1175{
1127 struct transfer_args ta; 1176 struct transfer_args ta;
1128 1177
1129 switch (ix) 1178 switch (ix)
… …
1145 break; 1194 break;
1146 1195
1147 case 3: 1196 case 3:
1148 prepare_cede (&ta); 1197 prepare_cede (&ta);
1149 break; 1198 break;
1199
1200 case 4:
1201 if (!prepare_cede_notself (&ta))
1202 XSRETURN_EMPTY;
1203
1204 break;
1150 } 1205 }
1151 1206
1207 BARRIER;
1152 TRANSFER (ta); 1208 TRANSFER (ta);
1153}
1154 1209
1155void 1210 if (GIMME_V != G_VOID && ta.next != ta.prev)
1156_clone_state_from (SV *dst, SV *src) 1211 XSRETURN_YES;
1212}
1213
1214bool
1215_destroy (SV *coro_sv)
1157 CODE: 1216 CODE:
1158{ 1217 RETVAL = coro_state_destroy (SvSTATE (coro_sv));
1159 struct coro *coro_src = SvSTATE (src); 1218 OUTPUT:
1160 1219 RETVAL
1161 sv_unmagic (SvRV (dst), PERL_MAGIC_ext);
1162
1163 ++coro_src->refcnt;
1164 sv_magicext (SvRV (dst), 0, PERL_MAGIC_ext, &coro_state_vtbl, (char *)coro_src, 0)->mg_flags |= MGf_DUP;
1165}
1166 1220
1167void 1221void
1168_exit (code) 1222_exit (code)
1169 int code 1223 int code
1170 PROTOTYPE: $ 1224 PROTOTYPE: $
… …
1207 coro_ready[i] = newAV (); 1261 coro_ready[i] = newAV ();
1208 1262
1209 { 1263 {
1210 SV *sv = perl_get_sv("Coro::API", 1); 1264 SV *sv = perl_get_sv("Coro::API", 1);
1211 1265
1212 coroapi.schedule = api_schedule; 1266 coroapi.schedule = api_schedule;
1213 coroapi.save = api_save; 1267 coroapi.save = api_save;
1214 coroapi.cede = api_cede; 1268 coroapi.cede = api_cede;
1269 coroapi.cede_notself = api_cede_notself;
1215 coroapi.ready = api_ready; 1270 coroapi.ready = api_ready;
1216 coroapi.is_ready = api_is_ready; 1271 coroapi.is_ready = api_is_ready;
1217 coroapi.nready = &coro_nready; 1272 coroapi.nready = &coro_nready;
1218 coroapi.current = coro_current; 1273 coroapi.current = coro_current;
1219 1274
1220 GCoroAPI = &coroapi; 1275 GCoroAPI = &coroapi;
1221 sv_setiv (sv, (IV)&coroapi); 1276 sv_setiv (sv, (IV)&coroapi);
1222 SvREADONLY_on (sv); 1277 SvREADONLY_on (sv);
1223 } 1278 }
… …
1239 RETVAL = coro->prio; 1294 RETVAL = coro->prio;
1240 1295
1241 if (items > 1) 1296 if (items > 1)
1242 { 1297 {
1243 if (ix) 1298 if (ix)
1244 newprio += coro->prio; 1299 newprio = coro->prio - newprio;
1245 1300
1246 if (newprio < PRIO_MIN) newprio = PRIO_MIN; 1301 if (newprio < PRIO_MIN) newprio = PRIO_MIN;
1247 if (newprio > PRIO_MAX) newprio = PRIO_MAX; 1302 if (newprio > PRIO_MAX) newprio = PRIO_MAX;
1248 1303
1249 coro->prio = newprio; 1304 coro->prio = newprio;
1250 } 1305 }
1251} 1306}
1307 OUTPUT:
1308 RETVAL
1252 1309
1253SV * 1310SV *
1254ready (SV *self) 1311ready (SV *self)
1255 PROTOTYPE: $ 1312 PROTOTYPE: $
1256 CODE: 1313 CODE:

Diff Legend

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