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.247 by root, Wed Sep 24 21:31:29 2008 UTC vs.
Revision 1.263 by root, Wed Nov 12 04:49:06 2008 UTC

46# define BOOT_PAGESIZE (void)0 46# define BOOT_PAGESIZE (void)0
47#endif 47#endif
48 48
49#if CORO_USE_VALGRIND 49#if CORO_USE_VALGRIND
50# include <valgrind/valgrind.h> 50# include <valgrind/valgrind.h>
51# define REGISTER_STACK(cctx,start,end) (cctx)->valgrind_id = VALGRIND_STACK_REGISTER ((start), (end))
52#else
53# define REGISTER_STACK(cctx,start,end)
54#endif 51#endif
55 52
56/* the maximum number of idle cctx that will be pooled */ 53/* the maximum number of idle cctx that will be pooled */
57#define MAX_IDLE_CCTX 8 54static int cctx_max_idle = 4;
58 55
59#define PERL_VERSION_ATLEAST(a,b,c) \ 56#define PERL_VERSION_ATLEAST(a,b,c) \
60 (PERL_REVISION > (a) \ 57 (PERL_REVISION > (a) \
61 || (PERL_REVISION == (a) \ 58 || (PERL_REVISION == (a) \
62 && (PERL_VERSION > (b) \ 59 && (PERL_VERSION > (b) \
81# ifndef IS_PADCONST 78# ifndef IS_PADCONST
82# define IS_PADCONST(v) 0 79# define IS_PADCONST(v) 0
83# endif 80# endif
84#endif 81#endif
85 82
83/* 5.11 */
84#ifndef CxHASARGS
85# define CxHASARGS(cx) (cx)->blk_sub.hasargs
86#endif
87
88/* 5.10.0 */
89#ifndef SvREFCNT_inc_NN
90# define SvREFCNT_inc_NN(sv) SvREFCNT_inc (sv)
91#endif
92
86/* 5.8.8 */ 93/* 5.8.8 */
87#ifndef GV_NOTQUAL 94#ifndef GV_NOTQUAL
88# define GV_NOTQUAL 0 95# define GV_NOTQUAL 0
89#endif 96#endif
90#ifndef newSV 97#ifndef newSV
91# define newSV(l) NEWSV(0,l) 98# define newSV(l) NEWSV(0,l)
92#endif
93
94/* 5.11 */
95#ifndef CxHASARGS
96# define CxHASARGS(cx) (cx)->blk_sub.hasargs
97#endif 99#endif
98 100
99/* 5.8.7 */ 101/* 5.8.7 */
100#ifndef SvRV_set 102#ifndef SvRV_set
101# define SvRV_set(s,v) SvRV(s) = (v) 103# define SvRV_set(s,v) SvRV(s) = (v)
123 125
124#if __GNUC__ >= 3 126#if __GNUC__ >= 3
125# define attribute(x) __attribute__(x) 127# define attribute(x) __attribute__(x)
126# define BARRIER __asm__ __volatile__ ("" : : : "memory") 128# define BARRIER __asm__ __volatile__ ("" : : : "memory")
127# define expect(expr,value) __builtin_expect ((expr),(value)) 129# define expect(expr,value) __builtin_expect ((expr),(value))
130# define INLINE static inline
128#else 131#else
129# define attribute(x) 132# define attribute(x)
130# define BARRIER 133# define BARRIER
131# define expect(expr,value) (expr) 134# define expect(expr,value) (expr)
135# define INLINE static
132#endif 136#endif
133 137
134#define expect_false(expr) expect ((expr) != 0, 0) 138#define expect_false(expr) expect ((expr) != 0, 0)
135#define expect_true(expr) expect ((expr) != 0, 1) 139#define expect_true(expr) expect ((expr) != 0, 1)
136 140
137#define NOINLINE attribute ((noinline)) 141#define NOINLINE attribute ((noinline))
138 142
139#include "CoroAPI.h" 143#include "CoroAPI.h"
140 144
141#ifdef USE_ITHREADS 145#ifdef USE_ITHREADS
146
142static perl_mutex coro_mutex; 147static perl_mutex coro_lock;
143# define LOCK do { MUTEX_LOCK (&coro_mutex); } while (0) 148# define LOCK do { MUTEX_LOCK (&coro_lock); } while (0)
144# define UNLOCK do { MUTEX_UNLOCK (&coro_mutex); } while (0) 149# define UNLOCK do { MUTEX_UNLOCK (&coro_lock); } while (0)
150# if CORO_PTHREAD
151static void *coro_thx;
152# endif
153
145#else 154#else
155
146# define LOCK (void)0 156# define LOCK (void)0
147# define UNLOCK (void)0 157# define UNLOCK (void)0
158
148#endif 159#endif
160
161# undef LOCK
162# define LOCK (void)0
163# undef UNLOCK
164# define UNLOCK (void)0
149 165
150/* helper storage struct for Coro::AIO */ 166/* helper storage struct for Coro::AIO */
151struct io_state 167struct io_state
152{ 168{
169 AV *res;
153 int errorno; 170 int errorno;
154 I32 laststype; 171 I32 laststype; /* U16 in 5.10.0 */
155 int laststatval; 172 int laststatval;
156 Stat_t statcache; 173 Stat_t statcache;
157}; 174};
158 175
159static double (*nvtime)(); /* so why doesn't it take void? */ 176static double (*nvtime)(); /* so why doesn't it take void? */
160 177
178static U32 cctx_gen;
161static size_t coro_stacksize = CORO_STACKSIZE; 179static size_t cctx_stacksize = CORO_STACKSIZE;
162static struct CoroAPI coroapi; 180static struct CoroAPI coroapi;
163static AV *main_mainstack; /* used to differentiate between $main and others */ 181static AV *main_mainstack; /* used to differentiate between $main and others */
164static JMPENV *main_top_env; 182static JMPENV *main_top_env;
165static HV *coro_state_stash, *coro_stash; 183static HV *coro_state_stash, *coro_stash;
166static volatile SV *coro_mortal; /* will be freed after next transfer */ 184static volatile SV *coro_mortal; /* will be freed/thrown after next transfer */
185static volatile struct coro *transfer_next;
186
187struct transfer_args
188{
189 struct coro *prev, *next;
190};
167 191
168static GV *irsgv; /* $/ */ 192static GV *irsgv; /* $/ */
169static GV *stdoutgv; /* *STDOUT */ 193static GV *stdoutgv; /* *STDOUT */
170static SV *rv_diehook; 194static SV *rv_diehook;
171static SV *rv_warnhook; 195static SV *rv_warnhook;
203 void *idle_sp; /* sp of top-level transfer/schedule/cede call */ 227 void *idle_sp; /* sp of top-level transfer/schedule/cede call */
204 JMPENV *idle_te; /* same as idle_sp, but for top_env, TODO: remove once stable */ 228 JMPENV *idle_te; /* same as idle_sp, but for top_env, TODO: remove once stable */
205 JMPENV *top_env; 229 JMPENV *top_env;
206 coro_context cctx; 230 coro_context cctx;
207 231
232 U32 gen;
208#if CORO_USE_VALGRIND 233#if CORO_USE_VALGRIND
209 int valgrind_id; 234 int valgrind_id;
210#endif 235#endif
211 unsigned char flags; 236 unsigned char flags;
212} coro_cctx; 237} coro_cctx;
272#define PRIO_MIN -4 297#define PRIO_MIN -4
273 298
274/* for Coro.pm */ 299/* for Coro.pm */
275static SV *coro_current; 300static SV *coro_current;
276static SV *coro_readyhook; 301static SV *coro_readyhook;
277static AV *coro_ready [PRIO_MAX-PRIO_MIN+1]; 302static AV *coro_ready [PRIO_MAX - PRIO_MIN + 1];
278static int coro_nready; 303static int coro_nready;
279static struct coro *coro_first; 304static struct coro *coro_first;
280 305
281/** lowlevel stuff **********************************************************/ 306/** lowlevel stuff **********************************************************/
282 307
324 Perl_pad_push (aTHX_ padlist, AvFILLp (padlist) + 1, 1); 349 Perl_pad_push (aTHX_ padlist, AvFILLp (padlist) + 1, 1);
325#endif 350#endif
326 newpad = (AV *)AvARRAY (padlist)[AvFILLp (padlist)]; 351 newpad = (AV *)AvARRAY (padlist)[AvFILLp (padlist)];
327 --AvFILLp (padlist); 352 --AvFILLp (padlist);
328 353
329 av_store (newpadlist, 0, SvREFCNT_inc (*av_fetch (padlist, 0, FALSE))); 354 av_store (newpadlist, 0, SvREFCNT_inc_NN (*av_fetch (padlist, 0, FALSE)));
330 av_store (newpadlist, 1, (SV *)newpad); 355 av_store (newpadlist, 1, (SV *)newpad);
331 356
332 return newpadlist; 357 return newpadlist;
333} 358}
334 359
377static MGVTBL coro_cv_vtbl = { 402static MGVTBL coro_cv_vtbl = {
378 0, 0, 0, 0, 403 0, 0, 0, 0,
379 coro_cv_free 404 coro_cv_free
380}; 405};
381 406
382#define CORO_MAGIC(sv,type) \ 407#define CORO_MAGIC(sv, type) \
383 SvMAGIC (sv) \ 408 SvMAGIC (sv) \
384 ? SvMAGIC (sv)->mg_type == type \ 409 ? SvMAGIC (sv)->mg_type == type \
385 ? SvMAGIC (sv) \ 410 ? SvMAGIC (sv) \
386 : mg_find (sv, type) \ 411 : mg_find (sv, type) \
387 : 0 412 : 0
388 413
389#define CORO_MAGIC_cv(cv) CORO_MAGIC (((SV *)(cv)), CORO_MAGIC_type_cv) 414#define CORO_MAGIC_cv(cv) CORO_MAGIC (((SV *)(cv)), CORO_MAGIC_type_cv)
390#define CORO_MAGIC_state(sv) CORO_MAGIC (((SV *)(sv)), CORO_MAGIC_type_state) 415#define CORO_MAGIC_state(sv) CORO_MAGIC (((SV *)(sv)), CORO_MAGIC_type_state)
391 416
392static struct coro * 417INLINE struct coro *
393SvSTATE_ (pTHX_ SV *coro) 418SvSTATE_ (pTHX_ SV *coro)
394{ 419{
395 HV *stash; 420 HV *stash;
396 MAGIC *mg; 421 MAGIC *mg;
397 422
622 647
623/* 648/*
624 * destroy the stacks, the callchain etc... 649 * destroy the stacks, the callchain etc...
625 */ 650 */
626static void 651static void
627coro_destroy_stacks (pTHX) 652coro_destruct_stacks (pTHX)
628{ 653{
629 while (PL_curstackinfo->si_next) 654 while (PL_curstackinfo->si_next)
630 PL_curstackinfo = PL_curstackinfo->si_next; 655 PL_curstackinfo = PL_curstackinfo->si_next;
631 656
632 while (PL_curstackinfo) 657 while (PL_curstackinfo)
700#ifndef MgPV_nolen_const 725#ifndef MgPV_nolen_const
701#define MgPV_nolen_const(mg) (((((int)(mg)->mg_len)) == HEf_SVKEY) ? \ 726#define MgPV_nolen_const(mg) (((((int)(mg)->mg_len)) == HEf_SVKEY) ? \
702 SvPV_nolen((SV*)((mg)->mg_ptr)) : \ 727 SvPV_nolen((SV*)((mg)->mg_ptr)) : \
703 (const char*)(mg)->mg_ptr) 728 (const char*)(mg)->mg_ptr)
704#endif 729#endif
730
731/* we sometimes need to create the effect of entersub calling us */
732#define ENTERSUB_HEAD ENTER; SAVETMPS
733/* we somtimes need to create the effect of leaving via entersub */
734#define ENTERSUB_TAIL LEAVE
705 735
706/* 736/*
707 * This overrides the default magic get method of %SIG elements. 737 * This overrides the default magic get method of %SIG elements.
708 * The original one doesn't provide for reading back of PL_diehook/PL_warnhook 738 * The original one doesn't provide for reading back of PL_diehook/PL_warnhook
709 * and instead of tryign to save and restore the hash elements, we just provide 739 * and instead of tryign to save and restore the hash elements, we just provide
810 GvSV (PL_defgv) = newSV (0); 840 GvSV (PL_defgv) = newSV (0);
811 GvAV (PL_defgv) = coro->args; coro->args = 0; 841 GvAV (PL_defgv) = coro->args; coro->args = 0;
812 GvSV (PL_errgv) = newSV (0); 842 GvSV (PL_errgv) = newSV (0);
813 GvSV (irsgv) = newSVpvn ("\n", 1); sv_magic (GvSV (irsgv), (SV *)irsgv, PERL_MAGIC_sv, "/", 0); 843 GvSV (irsgv) = newSVpvn ("\n", 1); sv_magic (GvSV (irsgv), (SV *)irsgv, PERL_MAGIC_sv, "/", 0);
814 PL_rs = newSVsv (GvSV (irsgv)); 844 PL_rs = newSVsv (GvSV (irsgv));
815 PL_defoutgv = (GV *)SvREFCNT_inc (stdoutgv); 845 PL_defoutgv = (GV *)SvREFCNT_inc_NN (stdoutgv);
816 846
817 { 847 {
818 dSP; 848 dSP;
819 LOGOP myop; 849 UNOP myop;
820 850
821 Zero (&myop, 1, LOGOP); 851 Zero (&myop, 1, UNOP);
822 myop.op_next = Nullop; 852 myop.op_next = Nullop;
823 myop.op_flags = OPf_WANT_VOID; 853 myop.op_flags = OPf_WANT_VOID;
824 854
825 PUSHMARK (SP); 855 PUSHMARK (SP);
826 XPUSHs (sv_2mortal (av_shift (GvAV (PL_defgv)))); 856 XPUSHs (sv_2mortal (av_shift (GvAV (PL_defgv))));
830 SPAGAIN; 860 SPAGAIN;
831 } 861 }
832 862
833 /* this newly created coroutine might be run on an existing cctx which most 863 /* this newly created coroutine might be run on an existing cctx which most
834 * likely was suspended in set_stacklevel, called from entersub. 864 * likely was suspended in set_stacklevel, called from entersub.
835 * set_stacklevl doesn't do anything on return, but entersub does LEAVE, 865 * set_stacklevel doesn't do anything on return, but entersub does LEAVE,
836 * so we ENTER here for symmetry 866 * so we ENTER here for symmetry.
837 */ 867 */
838 ENTER; 868 ENTERSUB_HEAD;
839} 869}
840 870
841static void 871static void
842coro_destroy (pTHX_ struct coro *coro) 872coro_destruct (pTHX_ struct coro *coro)
843{ 873{
844 if (!IN_DESTRUCT) 874 if (!IN_DESTRUCT)
845 { 875 {
846 /* restore all saved variables and stuff */ 876 /* restore all saved variables and stuff */
847 LEAVE_SCOPE (0); 877 LEAVE_SCOPE (0);
869 SvREFCNT_dec (PL_warnhook); 899 SvREFCNT_dec (PL_warnhook);
870 900
871 SvREFCNT_dec (coro->saved_deffh); 901 SvREFCNT_dec (coro->saved_deffh);
872 SvREFCNT_dec (coro->throw); 902 SvREFCNT_dec (coro->throw);
873 903
874 coro_destroy_stacks (aTHX); 904 coro_destruct_stacks (aTHX);
875} 905}
876 906
877static void 907INLINE void
878free_coro_mortal (pTHX) 908free_coro_mortal (pTHX)
879{ 909{
880 if (expect_true (coro_mortal)) 910 if (expect_true (coro_mortal))
881 { 911 {
882 SvREFCNT_dec (coro_mortal); 912 SvREFCNT_dec (coro_mortal);
916 : cx->blk_gimme == G_SCALAR ? bot + 1 946 : cx->blk_gimme == G_SCALAR ? bot + 1
917 : bot; 947 : bot;
918 948
919 av_extend (av, top - bot); 949 av_extend (av, top - bot);
920 while (bot < top) 950 while (bot < top)
921 av_push (av, SvREFCNT_inc (*bot++)); 951 av_push (av, SvREFCNT_inc_NN (*bot++));
922 952
923 PL_runops = RUNOPS_DEFAULT; 953 PL_runops = RUNOPS_DEFAULT;
924 ENTER; 954 ENTER;
925 SAVETMPS; 955 SAVETMPS;
926 EXTEND (SP, 3); 956 EXTEND (SP, 3);
1006 1036
1007 TAINT_NOT; 1037 TAINT_NOT;
1008 return 0; 1038 return 0;
1009} 1039}
1010 1040
1041static void
1042prepare_set_stacklevel (struct transfer_args *ta, struct coro_cctx *cctx)
1043{
1044 ta->prev = (struct coro *)cctx;
1045 ta->next = 0;
1046}
1047
1011/* inject a fake call to Coro::State::_cctx_init into the execution */ 1048/* inject a fake call to Coro::State::_cctx_init into the execution */
1012/* _cctx_init should be careful, as it could be called at almost any time */ 1049/* _cctx_init should be careful, as it could be called at almost any time */
1013/* during execution of a perl program */ 1050/* during execution of a perl program */
1051/* also initialises PL_top_env */
1014static void NOINLINE 1052static void NOINLINE
1015cctx_prepare (pTHX_ coro_cctx *cctx) 1053cctx_prepare (pTHX_ coro_cctx *cctx)
1016{ 1054{
1017 dSP; 1055 dSP;
1018 LOGOP myop; 1056 UNOP myop;
1019 1057
1020 PL_top_env = &PL_start_env; 1058 PL_top_env = &PL_start_env;
1021 1059
1022 if (cctx->flags & CC_TRACE) 1060 if (cctx->flags & CC_TRACE)
1023 PL_runops = runops_trace; 1061 PL_runops = runops_trace;
1024 1062
1025 Zero (&myop, 1, LOGOP); 1063 Zero (&myop, 1, UNOP);
1026 myop.op_next = PL_op; 1064 myop.op_next = PL_op;
1027 myop.op_flags = OPf_WANT_VOID | OPf_STACKED; 1065 myop.op_flags = OPf_WANT_VOID | OPf_STACKED;
1028 1066
1029 PUSHMARK (SP); 1067 PUSHMARK (SP);
1030 EXTEND (SP, 2); 1068 EXTEND (SP, 2);
1031 PUSHs (sv_2mortal (newSViv (PTR2IV (cctx)))); 1069 PUSHs (sv_2mortal (newSViv ((IV)cctx)));
1032 PUSHs ((SV *)get_cv ("Coro::State::_cctx_init", FALSE)); 1070 PUSHs ((SV *)get_cv ("Coro::State::_cctx_init", FALSE));
1033 PUTBACK; 1071 PUTBACK;
1034 PL_op = (OP *)&myop; 1072 PL_op = (OP *)&myop;
1035 PL_op = PL_ppaddr[OP_ENTERSUB](aTHX); 1073 PL_op = PL_ppaddr[OP_ENTERSUB](aTHX);
1036 SPAGAIN; 1074 SPAGAIN;
1037} 1075}
1038 1076
1077/* the tail of transfer: execute stuff we can only do after a transfer */
1078INLINE void
1079transfer_tail (pTHX)
1080{
1081 struct coro *next = (struct coro *)transfer_next;
1082 assert (!(transfer_next = 0)); /* just used for the side effect when asserts are enabled */
1083 assert (("FATAL: transfer_next was zero in transfer_tail (please report)", next));
1084
1085 free_coro_mortal (aTHX);
1086 UNLOCK;
1087
1088 if (expect_false (next->throw))
1089 {
1090 SV *exception = sv_2mortal (next->throw);
1091
1092 next->throw = 0;
1093 sv_setsv (ERRSV, exception);
1094 croak (0);
1095 }
1096}
1097
1039/* 1098/*
1040 * this is a _very_ stripped down perl interpreter ;) 1099 * this is a _very_ stripped down perl interpreter ;)
1041 */ 1100 */
1042static void 1101static void
1043cctx_run (void *arg) 1102cctx_run (void *arg)
1044{ 1103{
1104#ifdef USE_ITHREADS
1105# if CORO_PTHREAD
1106 PERL_SET_CONTEXT (coro_thx);
1107# endif
1108#endif
1109 {
1045 dTHX; 1110 dTHX;
1046 1111
1047 /* cctx_run is the alternative tail of transfer(), so unlock here. */ 1112 /* entersub called ENTER, but we never 'returned', undo that here */
1048 UNLOCK; 1113 ENTERSUB_TAIL;
1049 1114
1050 /* we now skip the entersub that lead to transfer() */ 1115 /* we now skip the entersub that did lead to transfer() */
1051 PL_op = PL_op->op_next; 1116 PL_op = PL_op->op_next;
1052 1117
1053 /* inject a fake subroutine call to cctx_init */ 1118 /* inject a fake subroutine call to cctx_init */
1054 cctx_prepare (aTHX_ (coro_cctx *)arg); 1119 cctx_prepare (aTHX_ (coro_cctx *)arg);
1055 1120
1121 /* cctx_run is the alternative tail of transfer() */
1122 transfer_tail (aTHX);
1123
1056 /* somebody or something will hit me for both perl_run and PL_restartop */ 1124 /* somebody or something will hit me for both perl_run and PL_restartop */
1057 PL_restartop = PL_op; 1125 PL_restartop = PL_op;
1058 perl_run (PL_curinterp); 1126 perl_run (PL_curinterp);
1059 1127
1060 /* 1128 /*
1061 * If perl-run returns we assume exit() was being called or the coro 1129 * If perl-run returns we assume exit() was being called or the coro
1062 * fell off the end, which seems to be the only valid (non-bug) 1130 * fell off the end, which seems to be the only valid (non-bug)
1063 * reason for perl_run to return. We try to exit by jumping to the 1131 * reason for perl_run to return. We try to exit by jumping to the
1064 * bootstrap-time "top" top_env, as we cannot restore the "main" 1132 * bootstrap-time "top" top_env, as we cannot restore the "main"
1065 * coroutine as Coro has no such concept 1133 * coroutine as Coro has no such concept
1066 */ 1134 */
1067 PL_top_env = main_top_env; 1135 PL_top_env = main_top_env;
1068 JMPENV_JUMP (2); /* I do not feel well about the hardcoded 2 at all */ 1136 JMPENV_JUMP (2); /* I do not feel well about the hardcoded 2 at all */
1137 }
1069} 1138}
1070 1139
1071static coro_cctx * 1140static coro_cctx *
1072cctx_new () 1141cctx_new ()
1073{ 1142{
1074 coro_cctx *cctx; 1143 coro_cctx *cctx;
1144
1145 ++cctx_count;
1146 New (0, cctx, 1, coro_cctx);
1147
1148 cctx->gen = cctx_gen;
1149 cctx->flags = 0;
1150 cctx->idle_sp = 0; /* can be accessed by transfer between cctx_run and set_stacklevel, on throw */
1151
1152 return cctx;
1153}
1154
1155/* create a new cctx only suitable as source */
1156static coro_cctx *
1157cctx_new_empty ()
1158{
1159 coro_cctx *cctx = cctx_new ();
1160
1161 cctx->sptr = 0;
1162 coro_create (&cctx->cctx, 0, 0, 0, 0);
1163
1164 return cctx;
1165}
1166
1167/* create a new cctx suitable as destination/running a perl interpreter */
1168static coro_cctx *
1169cctx_new_run ()
1170{
1171 coro_cctx *cctx = cctx_new ();
1075 void *stack_start; 1172 void *stack_start;
1076 size_t stack_size; 1173 size_t stack_size;
1077 1174
1078 ++cctx_count;
1079
1080 Newz (0, cctx, 1, coro_cctx);
1081
1082#if HAVE_MMAP 1175#if HAVE_MMAP
1083 cctx->ssize = ((coro_stacksize * sizeof (long) + PAGESIZE - 1) / PAGESIZE + CORO_STACKGUARD) * PAGESIZE; 1176 cctx->ssize = ((cctx_stacksize * sizeof (long) + PAGESIZE - 1) / PAGESIZE + CORO_STACKGUARD) * PAGESIZE;
1084 /* mmap supposedly does allocate-on-write for us */ 1177 /* mmap supposedly does allocate-on-write for us */
1085 cctx->sptr = mmap (0, cctx->ssize, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_PRIVATE|MAP_ANONYMOUS, 0, 0); 1178 cctx->sptr = mmap (0, cctx->ssize, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_PRIVATE|MAP_ANONYMOUS, 0, 0);
1086 1179
1087 if (cctx->sptr != (void *)-1) 1180 if (cctx->sptr != (void *)-1)
1088 { 1181 {
1089# if CORO_STACKGUARD 1182 #if CORO_STACKGUARD
1090 mprotect (cctx->sptr, CORO_STACKGUARD * PAGESIZE, PROT_NONE); 1183 mprotect (cctx->sptr, CORO_STACKGUARD * PAGESIZE, PROT_NONE);
1091# endif 1184 #endif
1092 stack_start = CORO_STACKGUARD * PAGESIZE + (char *)cctx->sptr; 1185 stack_start = (char *)cctx->sptr + CORO_STACKGUARD * PAGESIZE;
1093 stack_size = cctx->ssize - CORO_STACKGUARD * PAGESIZE; 1186 stack_size = cctx->ssize - CORO_STACKGUARD * PAGESIZE;
1094 cctx->flags |= CC_MAPPED; 1187 cctx->flags |= CC_MAPPED;
1095 } 1188 }
1096 else 1189 else
1097#endif 1190#endif
1098 { 1191 {
1099 cctx->ssize = coro_stacksize * (long)sizeof (long); 1192 cctx->ssize = cctx_stacksize * (long)sizeof (long);
1100 New (0, cctx->sptr, coro_stacksize, long); 1193 New (0, cctx->sptr, cctx_stacksize, long);
1101 1194
1102 if (!cctx->sptr) 1195 if (!cctx->sptr)
1103 { 1196 {
1104 perror ("FATAL: unable to allocate stack for coroutine"); 1197 perror ("FATAL: unable to allocate stack for coroutine");
1105 _exit (EXIT_FAILURE); 1198 _exit (EXIT_FAILURE);
1107 1200
1108 stack_start = cctx->sptr; 1201 stack_start = cctx->sptr;
1109 stack_size = cctx->ssize; 1202 stack_size = cctx->ssize;
1110 } 1203 }
1111 1204
1112 REGISTER_STACK (cctx, (char *)stack_start, (char *)stack_start + stack_size); 1205 #if CORO_USE_VALGRIND
1206 cctx->valgrind_id = VALGRIND_STACK_REGISTER ((char *)stack_start, (char *)stack_start + stack_size);
1207 #endif
1208
1113 coro_create (&cctx->cctx, cctx_run, (void *)cctx, stack_start, stack_size); 1209 coro_create (&cctx->cctx, cctx_run, (void *)cctx, stack_start, stack_size);
1114 1210
1115 return cctx; 1211 return cctx;
1116} 1212}
1117 1213
1120{ 1216{
1121 if (!cctx) 1217 if (!cctx)
1122 return; 1218 return;
1123 1219
1124 --cctx_count; 1220 --cctx_count;
1221 coro_destroy (&cctx->cctx);
1125 1222
1223 /* coro_transfer creates new, empty cctx's */
1224 if (cctx->sptr)
1225 {
1126#if CORO_USE_VALGRIND 1226 #if CORO_USE_VALGRIND
1127 VALGRIND_STACK_DEREGISTER (cctx->valgrind_id); 1227 VALGRIND_STACK_DEREGISTER (cctx->valgrind_id);
1128#endif 1228 #endif
1129 1229
1130#if HAVE_MMAP 1230#if HAVE_MMAP
1131 if (cctx->flags & CC_MAPPED) 1231 if (cctx->flags & CC_MAPPED)
1132 munmap (cctx->sptr, cctx->ssize); 1232 munmap (cctx->sptr, cctx->ssize);
1133 else 1233 else
1134#endif 1234#endif
1135 Safefree (cctx->sptr); 1235 Safefree (cctx->sptr);
1236 }
1136 1237
1137 Safefree (cctx); 1238 Safefree (cctx);
1138} 1239}
1139 1240
1140/* wether this cctx should be destructed */ 1241/* wether this cctx should be destructed */
1141#define CCTX_EXPIRED(cctx) ((cctx)->ssize < coro_stacksize || ((cctx)->flags & CC_NOREUSE)) 1242#define CCTX_EXPIRED(cctx) ((cctx)->gen != cctx_gen || ((cctx)->flags & CC_NOREUSE))
1142 1243
1143static coro_cctx * 1244static coro_cctx *
1144cctx_get (pTHX) 1245cctx_get (pTHX)
1145{ 1246{
1146 while (expect_true (cctx_first)) 1247 while (expect_true (cctx_first))
1153 return cctx; 1254 return cctx;
1154 1255
1155 cctx_destroy (cctx); 1256 cctx_destroy (cctx);
1156 } 1257 }
1157 1258
1158 return cctx_new (); 1259 return cctx_new_run ();
1159} 1260}
1160 1261
1161static void 1262static void
1162cctx_put (coro_cctx *cctx) 1263cctx_put (coro_cctx *cctx)
1163{ 1264{
1265 assert (("FATAL: cctx_put called on non-initialised cctx in Coro (please report)", cctx->sptr));
1266
1164 /* free another cctx if overlimit */ 1267 /* free another cctx if overlimit */
1165 if (expect_false (cctx_idle >= MAX_IDLE_CCTX)) 1268 if (expect_false (cctx_idle >= cctx_max_idle))
1166 { 1269 {
1167 coro_cctx *first = cctx_first; 1270 coro_cctx *first = cctx_first;
1168 cctx_first = first->next; 1271 cctx_first = first->next;
1169 --cctx_idle; 1272 --cctx_idle;
1170 1273
1202/* always use the TRANSFER macro */ 1305/* always use the TRANSFER macro */
1203static void NOINLINE 1306static void NOINLINE
1204transfer (pTHX_ struct coro *prev, struct coro *next, int force_cctx) 1307transfer (pTHX_ struct coro *prev, struct coro *next, int force_cctx)
1205{ 1308{
1206 dSTACKLEVEL; 1309 dSTACKLEVEL;
1207 static volatile int has_throw;
1208 1310
1209 /* sometimes transfer is only called to set idle_sp */ 1311 /* sometimes transfer is only called to set idle_sp */
1210 if (expect_false (!next)) 1312 if (expect_false (!next))
1211 { 1313 {
1212 ((coro_cctx *)prev)->idle_sp = STACKLEVEL; 1314 ((coro_cctx *)prev)->idle_sp = STACKLEVEL;
1216 { 1318 {
1217 coro_cctx *prev__cctx; 1319 coro_cctx *prev__cctx;
1218 1320
1219 if (expect_false (prev->flags & CF_NEW)) 1321 if (expect_false (prev->flags & CF_NEW))
1220 { 1322 {
1221 /* create a new empty context */ 1323 /* create a new empty/source context */
1222 Newz (0, prev->cctx, 1, coro_cctx); 1324 prev->cctx = cctx_new_empty ();
1223 prev->flags &= ~CF_NEW; 1325 prev->flags &= ~CF_NEW;
1224 prev->flags |= CF_RUNNING; 1326 prev->flags |= CF_RUNNING;
1225 } 1327 }
1226 1328
1227 prev->flags &= ~CF_RUNNING; 1329 prev->flags &= ~CF_RUNNING;
1242 else 1344 else
1243 load_perl (aTHX_ next); 1345 load_perl (aTHX_ next);
1244 1346
1245 prev__cctx = prev->cctx; 1347 prev__cctx = prev->cctx;
1246 1348
1247 /* possibly "free" the cctx */ 1349 /* possibly untie and reuse the cctx */
1248 if (expect_true ( 1350 if (expect_true (
1249 prev__cctx->idle_sp == STACKLEVEL 1351 prev__cctx->idle_sp == STACKLEVEL
1250 && !(prev__cctx->flags & CC_TRACE) 1352 && !(prev__cctx->flags & CC_TRACE)
1251 && !force_cctx 1353 && !force_cctx
1252 )) 1354 ))
1253 { 1355 {
1254 /* I assume that STACKLEVEL is a stronger indicator than PL_top_env changes */ 1356 /* I assume that STACKLEVEL is a stronger indicator than PL_top_env changes */
1255 assert (("ERROR: current top_env must equal previous top_env", PL_top_env == prev__cctx->idle_te)); 1357 assert (("FATAL: current top_env must equal previous top_env in Coro (please report)", PL_top_env == prev__cctx->idle_te));
1256 1358
1257 prev->cctx = 0; 1359 prev->cctx = 0;
1258 1360
1259 /* if the cctx is about to be destroyed we need to make sure we won't see it in cctx_get */ 1361 /* if the cctx is about to be destroyed we need to make sure we won't see it in cctx_get */
1260 /* without this the next cctx_get might destroy the prev__cctx while still in use */ 1362 /* without this the next cctx_get might destroy the prev__cctx while still in use */
1268 ++next->usecount; 1370 ++next->usecount;
1269 1371
1270 if (expect_true (!next->cctx)) 1372 if (expect_true (!next->cctx))
1271 next->cctx = cctx_get (aTHX); 1373 next->cctx = cctx_get (aTHX);
1272 1374
1273 has_throw = !!next->throw; 1375 assert (("FATAL: transfer_next already nonzero in Coro (please report)", !transfer_next));
1376 transfer_next = next;
1274 1377
1275 if (expect_false (prev__cctx != next->cctx)) 1378 if (expect_false (prev__cctx != next->cctx))
1276 { 1379 {
1277 prev__cctx->top_env = PL_top_env; 1380 prev__cctx->top_env = PL_top_env;
1278 PL_top_env = next->cctx->top_env; 1381 PL_top_env = next->cctx->top_env;
1279 coro_transfer (&prev__cctx->cctx, &next->cctx->cctx); 1382 coro_transfer (&prev__cctx->cctx, &next->cctx->cctx);
1280 } 1383 }
1281 1384
1282 free_coro_mortal (aTHX); 1385 transfer_tail (aTHX);
1283 UNLOCK;
1284
1285 if (expect_false (has_throw))
1286 {
1287 struct coro *coro = SvSTATE (coro_current);
1288
1289 if (coro->throw)
1290 {
1291 SV *exception = coro->throw;
1292 coro->throw = 0;
1293 sv_setsv (ERRSV, exception);
1294 croak (0);
1295 }
1296 }
1297 } 1386 }
1298} 1387}
1299
1300struct transfer_args
1301{
1302 struct coro *prev, *next;
1303};
1304 1388
1305#define TRANSFER(ta, force_cctx) transfer (aTHX_ (ta).prev, (ta).next, (force_cctx)) 1389#define TRANSFER(ta, force_cctx) transfer (aTHX_ (ta).prev, (ta).next, (force_cctx))
1306#define TRANSFER_CHECK(ta) transfer_check (aTHX_ (ta).prev, (ta).next) 1390#define TRANSFER_CHECK(ta) transfer_check (aTHX_ (ta).prev, (ta).next)
1307 1391
1308/** high level stuff ********************************************************/ 1392/** high level stuff ********************************************************/
1334 croak ("FATAL: tried to destroy currently running coroutine"); 1418 croak ("FATAL: tried to destroy currently running coroutine");
1335 1419
1336 save_perl (aTHX_ &temp); 1420 save_perl (aTHX_ &temp);
1337 load_perl (aTHX_ coro); 1421 load_perl (aTHX_ coro);
1338 1422
1339 coro_destroy (aTHX_ coro); 1423 coro_destruct (aTHX_ coro);
1340 1424
1341 load_perl (aTHX_ &temp); 1425 load_perl (aTHX_ &temp);
1342 1426
1343 coro->slot = 0; 1427 coro->slot = 0;
1344 } 1428 }
1450 LOCK; 1534 LOCK;
1451 1535
1452 sv_hook = coro_nready ? 0 : coro_readyhook; 1536 sv_hook = coro_nready ? 0 : coro_readyhook;
1453 xs_hook = coro_nready ? 0 : coroapi.readyhook; 1537 xs_hook = coro_nready ? 0 : coroapi.readyhook;
1454 1538
1455 coro_enq (aTHX_ SvREFCNT_inc (coro_sv)); 1539 coro_enq (aTHX_ SvREFCNT_inc_NN (coro_sv));
1456 ++coro_nready; 1540 ++coro_nready;
1457 1541
1458 UNLOCK; 1542 UNLOCK;
1459 1543
1460 if (sv_hook) 1544 if (sv_hook)
1481 1565
1482static int 1566static int
1483api_is_ready (SV *coro_sv) 1567api_is_ready (SV *coro_sv)
1484{ 1568{
1485 dTHX; 1569 dTHX;
1570
1486 return !!(SvSTATE (coro_sv)->flags & CF_READY); 1571 return !!(SvSTATE (coro_sv)->flags & CF_READY);
1487} 1572}
1488 1573
1489static void 1574INLINE void
1490prepare_schedule (pTHX_ struct transfer_args *ta) 1575prepare_schedule (pTHX_ struct transfer_args *ta)
1491{ 1576{
1492 SV *prev_sv, *next_sv; 1577 SV *prev_sv, *next_sv;
1493 1578
1494 for (;;) 1579 for (;;)
1520 /* cannot transfer to destroyed coros, skip and look for next */ 1605 /* cannot transfer to destroyed coros, skip and look for next */
1521 if (expect_false (ta->next->flags & CF_DESTROYED)) 1606 if (expect_false (ta->next->flags & CF_DESTROYED))
1522 { 1607 {
1523 UNLOCK; 1608 UNLOCK;
1524 SvREFCNT_dec (next_sv); 1609 SvREFCNT_dec (next_sv);
1525 /* coro_nready is already taken care of by destroy */ 1610 /* coro_nready has already been taken care of by destroy */
1526 continue; 1611 continue;
1527 } 1612 }
1528 1613
1529 --coro_nready; 1614 --coro_nready;
1530 UNLOCK; 1615 UNLOCK;
1533 1618
1534 /* free this only after the transfer */ 1619 /* free this only after the transfer */
1535 prev_sv = SvRV (coro_current); 1620 prev_sv = SvRV (coro_current);
1536 ta->prev = SvSTATE (prev_sv); 1621 ta->prev = SvSTATE (prev_sv);
1537 TRANSFER_CHECK (*ta); 1622 TRANSFER_CHECK (*ta);
1538 assert (ta->next->flags & CF_READY); 1623 assert (("FATAL: next coroutine isn't marked as ready in Coro (please report)", ta->next->flags & CF_READY));
1539 ta->next->flags &= ~CF_READY; 1624 ta->next->flags &= ~CF_READY;
1540 SvRV_set (coro_current, next_sv); 1625 SvRV_set (coro_current, next_sv);
1541 1626
1542 LOCK; 1627 LOCK;
1543 free_coro_mortal (aTHX); 1628 free_coro_mortal (aTHX);
1544 coro_mortal = prev_sv; 1629 coro_mortal = prev_sv;
1545 UNLOCK; 1630 UNLOCK;
1546} 1631}
1547 1632
1548static void 1633INLINE void
1549prepare_cede (pTHX_ struct transfer_args *ta) 1634prepare_cede (pTHX_ struct transfer_args *ta)
1550{ 1635{
1551 api_ready (coro_current); 1636 api_ready (coro_current);
1552 prepare_schedule (aTHX_ ta); 1637 prepare_schedule (aTHX_ ta);
1553} 1638}
1615 struct coro *coro = SvSTATE (coro_sv); 1700 struct coro *coro = SvSTATE (coro_sv);
1616 1701
1617 if (flags & CC_TRACE) 1702 if (flags & CC_TRACE)
1618 { 1703 {
1619 if (!coro->cctx) 1704 if (!coro->cctx)
1620 coro->cctx = cctx_new (); 1705 coro->cctx = cctx_new_run ();
1621 else if (!(coro->cctx->flags & CC_TRACE)) 1706 else if (!(coro->cctx->flags & CC_TRACE))
1622 croak ("cannot enable tracing on coroutine with custom stack"); 1707 croak ("cannot enable tracing on coroutine with custom stack");
1623 1708
1624 coro->cctx->flags |= CC_NOREUSE | (flags & (CC_TRACE | CC_TRACE_ALL)); 1709 coro->cctx->flags |= CC_NOREUSE | (flags & (CC_TRACE | CC_TRACE_ALL));
1625 } 1710 }
1632 else 1717 else
1633 coro->slot->runops = RUNOPS_DEFAULT; 1718 coro->slot->runops = RUNOPS_DEFAULT;
1634 } 1719 }
1635} 1720}
1636 1721
1722#if 0
1637static int 1723static int
1638coro_gensub_free (pTHX_ SV *sv, MAGIC *mg) 1724coro_gensub_free (pTHX_ SV *sv, MAGIC *mg)
1639{ 1725{
1640 AV *padlist; 1726 AV *padlist;
1641 AV *av = (AV *)mg->mg_obj; 1727 AV *av = (AV *)mg->mg_obj;
1647 1733
1648static MGVTBL coro_gensub_vtbl = { 1734static MGVTBL coro_gensub_vtbl = {
1649 0, 0, 0, 0, 1735 0, 0, 0, 0,
1650 coro_gensub_free 1736 coro_gensub_free
1651}; 1737};
1738#endif
1652 1739
1653/*****************************************************************************/ 1740/*****************************************************************************/
1654/* PerlIO::cede */ 1741/* PerlIO::cede */
1655 1742
1656typedef struct 1743typedef struct
1688 { 1775 {
1689 api_cede (); 1776 api_cede ();
1690 self->next = now + self->every; 1777 self->next = now + self->every;
1691 } 1778 }
1692 1779
1693 return PerlIOBuf_flush (f); 1780 return PerlIOBuf_flush (aTHX_ f);
1694} 1781}
1695 1782
1696static PerlIO_funcs PerlIO_cede = 1783static PerlIO_funcs PerlIO_cede =
1697{ 1784{
1698 sizeof(PerlIO_funcs), 1785 sizeof(PerlIO_funcs),
1731PROTOTYPES: DISABLE 1818PROTOTYPES: DISABLE
1732 1819
1733BOOT: 1820BOOT:
1734{ 1821{
1735#ifdef USE_ITHREADS 1822#ifdef USE_ITHREADS
1736 MUTEX_INIT (&coro_mutex); 1823 MUTEX_INIT (&coro_lock);
1824# if CORO_PTHREAD
1825 coro_thx = PERL_GET_CONTEXT;
1826# endif
1737#endif 1827#endif
1738 BOOT_PAGESIZE; 1828 BOOT_PAGESIZE;
1739 1829
1740 irsgv = gv_fetchpv ("/" , GV_ADD|GV_NOTQUAL, SVt_PV); 1830 irsgv = gv_fetchpv ("/" , GV_ADD|GV_NOTQUAL, SVt_PV);
1741 stdoutgv = gv_fetchpv ("STDOUT", GV_ADD|GV_NOTQUAL, SVt_PVIO); 1831 stdoutgv = gv_fetchpv ("STDOUT", GV_ADD|GV_NOTQUAL, SVt_PVIO);
1822 1912
1823 PUTBACK; 1913 PUTBACK;
1824 switch (ix) 1914 switch (ix)
1825 { 1915 {
1826 case 0: 1916 case 0:
1827 ta.prev = (struct coro *)INT2PTR (coro_cctx *, SvIV (ST (0))); 1917 prepare_set_stacklevel (&ta, (struct coro_cctx *)SvIV (ST (0)));
1828 ta.next = 0;
1829 break; 1918 break;
1830 1919
1831 case 1: 1920 case 1:
1832 if (items != 2) 1921 if (items != 2)
1833 croak ("Coro::State::transfer (prev,next) expects two arguments, not %d", items); 1922 croak ("Coro::State::transfer (prev, next) expects two arguments, not %d", items);
1834 1923
1835 prepare_transfer (aTHX_ &ta, ST (0), ST (1)); 1924 prepare_transfer (aTHX_ &ta, ST (0), ST (1));
1836 break; 1925 break;
1837 1926
1838 case 2: 1927 case 2:
1872 _exit (code); 1961 _exit (code);
1873 1962
1874int 1963int
1875cctx_stacksize (int new_stacksize = 0) 1964cctx_stacksize (int new_stacksize = 0)
1876 CODE: 1965 CODE:
1877 RETVAL = coro_stacksize; 1966 RETVAL = cctx_stacksize;
1878 if (new_stacksize) 1967 if (new_stacksize)
1968 {
1879 coro_stacksize = new_stacksize; 1969 cctx_stacksize = new_stacksize;
1970 ++cctx_gen;
1971 }
1972 OUTPUT:
1973 RETVAL
1974
1975int
1976cctx_max_idle (int max_idle = 0)
1977 CODE:
1978 RETVAL = cctx_max_idle;
1979 if (max_idle > 1)
1980 cctx_max_idle = max_idle;
1880 OUTPUT: 1981 OUTPUT:
1881 RETVAL 1982 RETVAL
1882 1983
1883int 1984int
1884cctx_count () 1985cctx_count ()
1962 RETVAL = boolSV (coro->flags & ix); 2063 RETVAL = boolSV (coro->flags & ix);
1963 OUTPUT: 2064 OUTPUT:
1964 RETVAL 2065 RETVAL
1965 2066
1966void 2067void
2068throw (Coro::State self, SV *throw = &PL_sv_undef)
2069 PROTOTYPE: $;$
2070 CODE:
2071 SvREFCNT_dec (self->throw);
2072 self->throw = SvOK (throw) ? newSVsv (throw) : 0;
2073
2074void
1967api_trace (SV *coro, int flags = CC_TRACE | CC_TRACE_SUB) 2075api_trace (SV *coro, int flags = CC_TRACE | CC_TRACE_SUB)
1968 2076
1969SV * 2077SV *
1970has_cctx (Coro::State coro) 2078has_cctx (Coro::State coro)
1971 PROTOTYPE: $ 2079 PROTOTYPE: $
1980 CODE: 2088 CODE:
1981 RETVAL = (coro->cctx ? coro->cctx->flags : 0) & CC_TRACE_ALL; 2089 RETVAL = (coro->cctx ? coro->cctx->flags : 0) & CC_TRACE_ALL;
1982 OUTPUT: 2090 OUTPUT:
1983 RETVAL 2091 RETVAL
1984 2092
1985IV 2093UV
1986rss (Coro::State coro) 2094rss (Coro::State coro)
1987 PROTOTYPE: $ 2095 PROTOTYPE: $
1988 ALIAS: 2096 ALIAS:
1989 usecount = 1 2097 usecount = 1
1990 CODE: 2098 CODE:
2001 CODE: 2109 CODE:
2002 struct coro *coro = SvSTATE (coro_current); 2110 struct coro *coro = SvSTATE (coro_current);
2003 coro->cctx->idle_sp = 0; 2111 coro->cctx->idle_sp = 0;
2004 2112
2005void 2113void
2006throw (Coro::State self, SV *throw = &PL_sv_undef)
2007 PROTOTYPE: $;$
2008 CODE:
2009 SvREFCNT_dec (self->throw);
2010 self->throw = SvOK (throw) ? newSVsv (throw) : 0;
2011
2012void
2013swap_defsv (Coro::State self) 2114swap_defsv (Coro::State self)
2014 PROTOTYPE: $ 2115 PROTOTYPE: $
2015 ALIAS: 2116 ALIAS:
2016 swap_defav = 1 2117 swap_defav = 1
2017 CODE: 2118 CODE:
2049 2150
2050 for (i = PRIO_MAX - PRIO_MIN + 1; i--; ) 2151 for (i = PRIO_MAX - PRIO_MIN + 1; i--; )
2051 coro_ready[i] = newAV (); 2152 coro_ready[i] = newAV ();
2052 2153
2053 { 2154 {
2054 SV *sv = perl_get_sv ("Coro::API", TRUE); 2155 SV *sv = coro_get_sv (aTHX_ "Coro::API", TRUE);
2055 perl_get_sv ("Coro::API", TRUE); /* silence 5.10 warning */
2056 2156
2057 coroapi.schedule = api_schedule; 2157 coroapi.schedule = api_schedule;
2058 coroapi.cede = api_cede; 2158 coroapi.cede = api_cede;
2059 coroapi.cede_notself = api_cede_notself; 2159 coroapi.cede_notself = api_cede_notself;
2060 coroapi.ready = api_ready; 2160 coroapi.ready = api_ready;
2071void 2171void
2072_set_current (SV *current) 2172_set_current (SV *current)
2073 PROTOTYPE: $ 2173 PROTOTYPE: $
2074 CODE: 2174 CODE:
2075 SvREFCNT_dec (SvRV (coro_current)); 2175 SvREFCNT_dec (SvRV (coro_current));
2076 SvRV_set (coro_current, SvREFCNT_inc (SvRV (current))); 2176 SvRV_set (coro_current, SvREFCNT_inc_NN (SvRV (current)));
2077 2177
2078void 2178void
2079_set_readyhook (SV *hook) 2179_set_readyhook (SV *hook)
2080 PROTOTYPE: $ 2180 PROTOTYPE: $
2081 CODE: 2181 CODE:
2141 SvREFCNT_dec (old); 2241 SvREFCNT_dec (old);
2142 croak ("\3async_pool terminate\2\n"); 2242 croak ("\3async_pool terminate\2\n");
2143 } 2243 }
2144 2244
2145 SvREFCNT_dec (coro->saved_deffh); 2245 SvREFCNT_dec (coro->saved_deffh);
2146 coro->saved_deffh = SvREFCNT_inc ((SV *)PL_defoutgv); 2246 coro->saved_deffh = SvREFCNT_inc_NN ((SV *)PL_defoutgv);
2147 2247
2148 hv_store (hv, "desc", sizeof ("desc") - 1, 2248 hv_store (hv, "desc", sizeof ("desc") - 1,
2149 newSVpvn ("[async_pool]", sizeof ("[async_pool]") - 1), 0); 2249 newSVpvn ("[async_pool]", sizeof ("[async_pool]") - 1), 0);
2150 2250
2151 invoke_av = (AV *)SvRV (invoke); 2251 invoke_av = (AV *)SvRV (invoke);
2155 2255
2156 if (len > 0) 2256 if (len > 0)
2157 { 2257 {
2158 av_fill (defav, len - 1); 2258 av_fill (defav, len - 1);
2159 for (i = 0; i < len; ++i) 2259 for (i = 0; i < len; ++i)
2160 av_store (defav, i, SvREFCNT_inc (AvARRAY (invoke_av)[i + 1])); 2260 av_store (defav, i, SvREFCNT_inc_NN (AvARRAY (invoke_av)[i + 1]));
2161 } 2261 }
2162 2262
2163 SvREFCNT_dec (invoke); 2263 SvREFCNT_dec (invoke);
2164} 2264}
2165 2265
2172 sv_setsv (cb, &PL_sv_undef); 2272 sv_setsv (cb, &PL_sv_undef);
2173 2273
2174 SvREFCNT_dec ((SV *)PL_defoutgv); PL_defoutgv = (GV *)coro->saved_deffh; 2274 SvREFCNT_dec ((SV *)PL_defoutgv); PL_defoutgv = (GV *)coro->saved_deffh;
2175 coro->saved_deffh = 0; 2275 coro->saved_deffh = 0;
2176 2276
2177 if (coro_rss (aTHX_ coro) > SvIV (sv_pool_rss) 2277 if (coro_rss (aTHX_ coro) > SvUV (sv_pool_rss)
2178 || av_len (av_async_pool) + 1 >= SvIV (sv_pool_size)) 2278 || av_len (av_async_pool) + 1 >= SvIV (sv_pool_size))
2179 { 2279 {
2180 SV *old = PL_diehook; 2280 SV *old = PL_diehook;
2181 PL_diehook = 0; 2281 PL_diehook = 0;
2182 SvREFCNT_dec (old); 2282 SvREFCNT_dec (old);
2244#endif 2344#endif
2245 2345
2246 2346
2247MODULE = Coro::State PACKAGE = Coro::AIO 2347MODULE = Coro::State PACKAGE = Coro::AIO
2248 2348
2249SV * 2349void
2250_get_state () 2350_get_state (SV *self)
2251 CODE: 2351 PPCODE:
2252{ 2352{
2253 struct io_state *data; 2353 AV *defav = GvAV (PL_defgv);
2254 2354 AV *av = newAV ();
2355 int i;
2255 RETVAL = newSV (sizeof (struct io_state)); 2356 SV *data_sv = newSV (sizeof (struct io_state));
2256 data = (struct io_state *)SvPVX (RETVAL); 2357 struct io_state *data = (struct io_state *)SvPVX (data_sv);
2257 SvCUR_set (RETVAL, sizeof (struct io_state)); 2358 SvCUR_set (data_sv, sizeof (struct io_state));
2258 SvPOK_only (RETVAL); 2359 SvPOK_only (data_sv);
2259 2360
2260 data->errorno = errno; 2361 data->errorno = errno;
2261 data->laststype = PL_laststype; 2362 data->laststype = PL_laststype;
2262 data->laststatval = PL_laststatval; 2363 data->laststatval = PL_laststatval;
2263 data->statcache = PL_statcache; 2364 data->statcache = PL_statcache;
2365
2366 av_extend (av, AvFILLp (defav) + 1 + 1);
2367
2368 for (i = 0; i <= AvFILLp (defav); ++i)
2369 av_push (av, SvREFCNT_inc_NN (AvARRAY (defav)[i]));
2370
2371 av_push (av, data_sv);
2372
2373 XPUSHs (sv_2mortal (newRV_noinc ((SV *)av)));
2374
2375 api_ready (self);
2264} 2376}
2265 OUTPUT:
2266 RETVAL
2267 2377
2268void 2378void
2269_set_state (char *data_) 2379_set_state (SV *state)
2270 PROTOTYPE: $ 2380 PROTOTYPE: $
2271 CODE: 2381 PPCODE:
2272{ 2382{
2273 struct io_state *data = (void *)data_; 2383 AV *av = (AV *)SvRV (state);
2384 struct io_state *data = (struct io_state *)SvPVX (AvARRAY (av)[AvFILLp (av)]);
2385 int i;
2274 2386
2275 errno = data->errorno; 2387 errno = data->errorno;
2276 PL_laststype = data->laststype; 2388 PL_laststype = data->laststype;
2277 PL_laststatval = data->laststatval; 2389 PL_laststatval = data->laststatval;
2278 PL_statcache = data->statcache; 2390 PL_statcache = data->statcache;
2391
2392 EXTEND (SP, AvFILLp (av));
2393 for (i = 0; i < AvFILLp (av); ++i)
2394 PUSHs (sv_2mortal (SvREFCNT_inc_NN (AvARRAY (av)[i])));
2279} 2395}
2280 2396
2281 2397
2282MODULE = Coro::State PACKAGE = Coro::AnyEvent 2398MODULE = Coro::State PACKAGE = Coro::AnyEvent
2283 2399
2312 2428
2313MODULE = Coro::State PACKAGE = PerlIO::cede 2429MODULE = Coro::State PACKAGE = PerlIO::cede
2314 2430
2315BOOT: 2431BOOT:
2316 PerlIO_define_layer (aTHX_ &PerlIO_cede); 2432 PerlIO_define_layer (aTHX_ &PerlIO_cede);
2433

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines