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.5 by root, Tue Jul 17 02:55:29 2001 UTC vs.
Revision 1.110 by root, Tue Nov 28 23:08:07 2006 UTC

1#include "libcoro/coro.c"
2
1#include "EXTERN.h" 3#include "EXTERN.h"
2#include "perl.h" 4#include "perl.h"
3#include "XSUB.h" 5#include "XSUB.h"
4 6
5#if 0 7#include "patchlevel.h"
6# define CHK(x) (void *)0 8
9#if USE_VALGRIND
10# include <valgrind/valgrind.h>
11#endif
12
13#define PERL_VERSION_ATLEAST(a,b,c) \
14 (PERL_REVISION > (a) \
15 || (PERL_REVISION == (a) \
16 && (PERL_VERSION > (b) \
17 || (PERL_VERSION == (b) && PERLSUBVERSION >= (c)))))
18
19#if !PERL_VERSION_ATLEAST (5,6,0)
20# ifndef PL_ppaddr
21# define PL_ppaddr ppaddr
22# endif
23# ifndef call_sv
24# define call_sv perl_call_sv
25# endif
26# ifndef get_sv
27# define get_sv perl_get_sv
28# endif
29# ifndef get_cv
30# define get_cv perl_get_cv
31# endif
32# ifndef IS_PADGV
33# define IS_PADGV(v) 0
34# endif
35# ifndef IS_PADCONST
36# define IS_PADCONST(v) 0
37# endif
38#endif
39
40#include <stdio.h>
41#include <errno.h>
42
43#if !__i386 && !__x86_64 && !__powerpc && !__m68k && !__alpha && !__mips && !__sparc64
44# undef STACKGUARD
45#endif
46
47#ifndef STACKGUARD
48# define STACKGUARD 0
49#endif
50
51#ifdef HAVE_MMAP
52# include <unistd.h>
53# include <sys/mman.h>
54# ifndef MAP_ANONYMOUS
55# ifdef MAP_ANON
56# define MAP_ANONYMOUS MAP_ANON
57# else
58# undef HAVE_MMAP
59# endif
60# endif
61# include <limits.h>
62# ifndef PAGESIZE
63# define PAGESIZE pagesize
64# define BOOT_PAGESIZE pagesize = sysconf (_SC_PAGESIZE)
65static long pagesize;
66# else
67# define BOOT_PAGESIZE (void)0
68# endif
7#else 69#else
8# define CHK(x) if (!(x)) croak("FATAL, CHK: " #x) 70# define PAGESIZE 0
71# define BOOT_PAGESIZE (void)0
9#endif 72#endif
10 73
74/* The next macro should declare a variable stacklevel that contains and approximation
75 * to the current C stack pointer. Its property is that it changes with each call
76 * and should be unique. */
77#define dSTACKLEVEL int stacklevel
78#define STACKLEVEL ((void *)&stacklevel)
79
80#define IN_DESTRUCT (PL_main_cv == Nullcv)
81
82#if __GNUC__ >= 3
83# define attribute(x) __attribute__(x)
84#else
85# define attribute(x)
86#endif
87
88#define NOINLINE attribute ((noinline))
89
90#include "CoroAPI.h"
91
92#define TRANSFER_SET_STACKLEVEL 0x8bfbfbfb /* magic cookie */
93
94#ifdef USE_ITHREADS
95static perl_mutex coro_mutex;
96# define LOCK do { MUTEX_LOCK (&coro_mutex); } while (0)
97# define UNLOCK do { MUTEX_UNLOCK (&coro_mutex); } while (0)
98#else
99# define LOCK (void)0
100# define UNLOCK (void)0
101#endif
102
103static struct CoroAPI coroapi;
104static AV *main_mainstack; /* used to differentiate between $main and others */
105static HV *coro_state_stash, *coro_stash;
106static SV *coro_mortal; /* will be freed after next transfer */
107
108static struct coro_cctx *cctx_first;
109static int cctx_count, cctx_idle;
110
111/* this is a structure representing a c-level coroutine */
112typedef struct coro_cctx {
113 struct coro_cctx *next;
114
115 /* the stack */
116 void *sptr;
117 long ssize; /* positive == mmap, otherwise malloc */
118
119 /* cpu state */
120 void *idle_sp; /* sp of top-level transfer/schedule/cede call */
121 JMPENV *top_env;
122 coro_context cctx;
123
124#if USE_VALGRIND
125 int valgrind_id;
126#endif
127} coro_cctx;
128
129/* this is a structure representing a perl-level coroutine */
11struct coro { 130struct coro {
12 U8 dowarn; 131 /* the c coroutine allocated to this perl coroutine, if any */
132 coro_cctx *cctx;
133
134 /* data associated with this coroutine (initial args) */
135 AV *args;
136 int refcnt;
137
138 /* optionally saved, might be zero */
13 AV *defav; 139 AV *defav;
140 SV *defsv;
141 SV *errsv;
14 142
15 PERL_SI *curstackinfo; 143#define VAR(name,type) type name;
16 AV *curstack; 144# include "state.h"
17 AV *mainstack; 145#undef VAR
18 SV **stack_sp;
19 OP *op;
20 SV **curpad;
21 SV **stack_base;
22 SV **stack_max;
23 SV **tmps_stack;
24 I32 tmps_floor;
25 I32 tmps_ix;
26 I32 tmps_max;
27 I32 *markstack;
28 I32 *markstack_ptr;
29 I32 *markstack_max;
30 I32 *scopestack;
31 I32 scopestack_ix;
32 I32 scopestack_max;
33 ANY *savestack;
34 I32 savestack_ix;
35 I32 savestack_max;
36 OP **retstack;
37 I32 retstack_ix;
38 I32 retstack_max;
39 COP *curcop;
40 146
41 AV *args; 147 /* coro process data */
148 int prio;
42}; 149};
43 150
44typedef struct coro *Coro__State; 151typedef struct coro *Coro__State;
45typedef struct coro *Coro__State_or_hashref; 152typedef struct coro *Coro__State_or_hashref;
46 153
47static HV *padlist_cache; 154static AV *
48 155coro_clone_padlist (CV *cv)
49/* mostly copied from op.c:cv_clone2 */
50STATIC AV *
51clone_padlist (AV *protopadlist)
52{ 156{
53 AV *av; 157 AV *padlist = CvPADLIST (cv);
54 I32 ix;
55 AV *protopad_name = (AV *) * av_fetch (protopadlist, 0, FALSE);
56 AV *protopad = (AV *) * av_fetch (protopadlist, 1, FALSE);
57 SV **pname = AvARRAY (protopad_name);
58 SV **ppad = AvARRAY (protopad);
59 I32 fname = AvFILLp (protopad_name);
60 I32 fpad = AvFILLp (protopad);
61 AV *newpadlist, *newpad_name, *newpad; 158 AV *newpadlist, *newpad;
62 SV **npad;
63
64 newpad_name = newAV ();
65 for (ix = fname; ix >= 0; ix--)
66 av_store (newpad_name, ix, SvREFCNT_inc (pname[ix]));
67
68 newpad = newAV ();
69 av_fill (newpad, AvFILLp (protopad));
70 npad = AvARRAY (newpad);
71 159
72 newpadlist = newAV (); 160 newpadlist = newAV ();
73 AvREAL_off (newpadlist); 161 AvREAL_off (newpadlist);
74 av_store (newpadlist, 0, (SV *) newpad_name); 162#if PERL_VERSION_ATLEAST (5,9,0)
163 Perl_pad_push (aTHX_ padlist, AvFILLp (padlist) + 1);
164#else
165 Perl_pad_push (aTHX_ padlist, AvFILLp (padlist) + 1, 1);
166#endif
167 newpad = (AV *)AvARRAY (padlist)[AvFILLp (padlist)];
168 --AvFILLp (padlist);
169
170 av_store (newpadlist, 0, SvREFCNT_inc (*av_fetch (padlist, 0, FALSE)));
75 av_store (newpadlist, 1, (SV *) newpad); 171 av_store (newpadlist, 1, (SV *)newpad);
76 172
77 av = newAV (); /* will be @_ */ 173 return newpadlist;
78 av_extend (av, 0); 174}
79 av_store (newpad, 0, (SV *) av);
80 AvFLAGS (av) = AVf_REIFY;
81 175
82 for (ix = fpad; ix > 0; ix--) 176static void
177free_padlist (AV *padlist)
178{
179 /* may be during global destruction */
180 if (SvREFCNT (padlist))
83 { 181 {
84 SV *namesv = (ix <= fname) ? pname[ix] : Nullsv; 182 I32 i = AvFILLp (padlist);
85 if (namesv && namesv != &PL_sv_undef) 183 while (i >= 0)
86 { 184 {
87 char *name = SvPVX (namesv); /* XXX */ 185 SV **svp = av_fetch (padlist, i--, FALSE);
88 if (SvFLAGS (namesv) & SVf_FAKE || *name == '&') 186 if (svp)
89 { /* lexical from outside? */
90 npad[ix] = SvREFCNT_inc (ppad[ix]);
91 } 187 {
92 else
93 { /* our own lexical */
94 SV *sv; 188 SV *sv;
95 if (*name == '&') 189 while (&PL_sv_undef != (sv = av_pop ((AV *)*svp)))
96 sv = SvREFCNT_inc (ppad[ix]); 190 SvREFCNT_dec (sv);
97 else if (*name == '@') 191
98 sv = (SV *) newAV (); 192 SvREFCNT_dec (*svp);
99 else if (*name == '%')
100 sv = (SV *) newHV ();
101 else
102 sv = NEWSV (0, 0);
103 if (!SvPADBUSY (sv))
104 SvPADMY_on (sv);
105 npad[ix] = sv;
106 } 193 }
107 } 194 }
108 else if (IS_PADGV (ppad[ix]) || IS_PADCONST (ppad[ix])) 195
109 { 196 SvREFCNT_dec ((SV*)padlist);
110 npad[ix] = SvREFCNT_inc (ppad[ix]);
111 }
112 else
113 {
114 SV *sv = NEWSV (0, 0);
115 SvPADTMP_on (sv);
116 npad[ix] = sv;
117 }
118 } 197 }
198}
119 199
120#if 0 /* NONOTUNDERSTOOD */ 200static int
121 /* Now that vars are all in place, clone nested closures. */ 201coro_cv_free (pTHX_ SV *sv, MAGIC *mg)
202{
203 AV *padlist;
204 AV *av = (AV *)mg->mg_obj;
122 205
123 for (ix = fpad; ix > 0; ix--) { 206 /* casting is fun. */
124 SV* namesv = (ix <= fname) ? pname[ix] : Nullsv; 207 while (&PL_sv_undef != (SV *)(padlist = (AV *)av_pop (av)))
125 if (namesv 208 free_padlist (padlist);
126 && namesv != &PL_sv_undef 209
127 && !(SvFLAGS(namesv) & SVf_FAKE) 210 SvREFCNT_dec (av);
128 && *SvPVX(namesv) == '&' 211
129 && CvCLONE(ppad[ix])) 212 return 0;
130 { 213}
131 CV *kid = cv_clone((CV*)ppad[ix]); 214
132 SvREFCNT_dec(ppad[ix]); 215#define PERL_MAGIC_coro PERL_MAGIC_ext
133 CvCLONE_on(kid); 216
134 SvPADMY_on(kid); 217static MGVTBL vtbl_coro = {0, 0, 0, 0, coro_cv_free};
135 npad[ix] = (SV*)kid; 218
136 } 219#define CORO_MAGIC(cv) \
220 SvMAGIC (cv) \
221 ? SvMAGIC (cv)->mg_type == PERL_MAGIC_coro \
222 ? SvMAGIC (cv) \
223 : mg_find ((SV *)cv, PERL_MAGIC_coro) \
224 : 0
225
226/* the next two functions merely cache the padlists */
227static void
228get_padlist (CV *cv)
229{
230 MAGIC *mg = CORO_MAGIC (cv);
231 AV *av;
232
233 if (mg && AvFILLp ((av = (AV *)mg->mg_obj)) >= 0)
234 CvPADLIST (cv) = (AV *)AvARRAY (av)[AvFILLp (av)--];
235 else
236 {
237#if 0
238 /* this is probably cleaner, but also slower? */
239 CV *cp = Perl_cv_clone (cv);
240 CvPADLIST (cv) = CvPADLIST (cp);
241 CvPADLIST (cp) = 0;
242 SvREFCNT_dec (cp);
243#else
244 CvPADLIST (cv) = coro_clone_padlist (cv);
245#endif
246 }
247}
248
249static void
250put_padlist (CV *cv)
251{
252 MAGIC *mg = CORO_MAGIC (cv);
253 AV *av;
254
255 if (!mg)
256 {
257 sv_magic ((SV *)cv, 0, PERL_MAGIC_coro, 0, 0);
258 mg = mg_find ((SV *)cv, PERL_MAGIC_coro);
259 mg->mg_virtual = &vtbl_coro;
260 mg->mg_obj = (SV *)newAV ();
137 } 261 }
138#endif
139 262
140 return newpadlist; 263 av = (AV *)mg->mg_obj;
141}
142 264
143STATIC AV * 265 if (AvFILLp (av) >= AvMAX (av))
144free_padlist (AV *padlist) 266 av_extend (av, AvMAX (av) + 1);
267
268 AvARRAY (av)[++AvFILLp (av)] = (SV *)CvPADLIST (cv);
269}
270
271#define SB do {
272#define SE } while (0)
273
274#define LOAD(state) load_state((state));
275#define SAVE(state,flags) save_state((state),(flags));
276
277#define REPLACE_SV(sv,val) SB SvREFCNT_dec(sv); (sv) = (val); (val) = 0; SE
278
279static void
280load_state(Coro__State c)
145{ 281{
146 /* may be during global destruction */ 282#define VAR(name,type) PL_ ## name = c->name;
147 if (SvREFCNT(padlist)) 283# include "state.h"
284#undef VAR
285
286 if (c->defav) REPLACE_SV (GvAV (PL_defgv), c->defav);
287 if (c->defsv) REPLACE_SV (DEFSV , c->defsv);
288 if (c->errsv) REPLACE_SV (ERRSV , c->errsv);
289
148 { 290 {
149 I32 i = AvFILLp(padlist); 291 dSP;
150 while (i >= 0) 292 CV *cv;
293
294 /* now do the ugly restore mess */
295 while ((cv = (CV *)POPs))
151 { 296 {
152 SV **svp = av_fetch(padlist, i--, FALSE); 297 put_padlist (cv); /* mark this padlist as available */
153 SV *sv = svp ? *svp : Nullsv; 298 CvDEPTH (cv) = PTR2IV (POPs);
154 if (sv) 299 CvPADLIST (cv) = (AV *)POPs;
155 SvREFCNT_dec(sv);
156 } 300 }
157 301
158 SvREFCNT_dec((SV*)padlist); 302 PUTBACK;
159 } 303 }
160} 304}
161 305
162/* the next tow functions merely cache the padlists */
163STATIC void
164get_padlist (CV *cv)
165{
166 SV **he = hv_fetch (padlist_cache, (void *)&cv, sizeof (CV *), 0);
167
168 if (he && AvFILLp ((AV *)*he) >= 0)
169 CvPADLIST (cv) = (AV *)av_pop ((AV *)*he);
170 else
171 CvPADLIST (cv) = clone_padlist (CvPADLIST (cv));
172}
173
174STATIC void
175put_padlist (CV *cv)
176{
177 SV **he = hv_fetch (padlist_cache, (void *)&cv, sizeof (CV *), 1);
178
179 if (SvTYPE (*he) != SVt_PVAV)
180 {
181 SvREFCNT_dec (*he);
182 *he = (SV *)newAV ();
183 }
184
185 av_push ((AV *)*he, (SV *)CvPADLIST (cv));
186}
187
188static void 306static void
189SAVE(pTHX_ Coro__State c) 307save_state(Coro__State c, int flags)
190{ 308{
191 { 309 {
192 dSP; 310 dSP;
193 I32 cxix = cxstack_ix; 311 I32 cxix = cxstack_ix;
312 PERL_CONTEXT *ccstk = cxstack;
194 PERL_SI *top_si = PL_curstackinfo; 313 PERL_SI *top_si = PL_curstackinfo;
195 PERL_CONTEXT *ccstk = cxstack;
196 314
197 /* 315 /*
198 * the worst thing you can imagine happens first - we have to save 316 * the worst thing you can imagine happens first - we have to save
199 * (and reinitialize) all cv's in the whole callchain :( 317 * (and reinitialize) all cv's in the whole callchain :(
200 */ 318 */
… …
208 PERL_CONTEXT *cx = &ccstk[cxix--]; 326 PERL_CONTEXT *cx = &ccstk[cxix--];
209 327
210 if (CxTYPE(cx) == CXt_SUB) 328 if (CxTYPE(cx) == CXt_SUB)
211 { 329 {
212 CV *cv = cx->blk_sub.cv; 330 CV *cv = cx->blk_sub.cv;
331
213 if (CvDEPTH(cv)) 332 if (CvDEPTH (cv))
214 { 333 {
215#ifdef USE_THREADS
216 XPUSHs ((SV *)CvOWNER(cv));
217#endif
218 EXTEND (SP, 3); 334 EXTEND (SP, 3);
219 PUSHs ((SV *)CvDEPTH(cv)); 335
220 PUSHs ((SV *)CvPADLIST(cv)); 336 PUSHs ((SV *)CvPADLIST(cv));
337 PUSHs (INT2PTR (SV *, CvDEPTH (cv)));
221 PUSHs ((SV *)cv); 338 PUSHs ((SV *)cv);
222 339
340 CvDEPTH (cv) = 0;
223 get_padlist (cv); 341 get_padlist (cv);
224
225 CvDEPTH(cv) = 0;
226#ifdef USE_THREADS
227 CvOWNER(cv) = 0;
228 error must unlock this cv etc.. etc...
229 if you are here wondering about this error message then
230 the reason is that it will not work as advertised yet
231#endif
232 } 342 }
233 } 343 }
344#ifdef CXt_FORMAT
234 else if (CxTYPE(cx) == CXt_FORMAT) 345 else if (CxTYPE(cx) == CXt_FORMAT)
235 { 346 {
236 /* I never used formats, so how should I know how these are implemented? */ 347 /* I never used formats, so how should I know how these are implemented? */
237 /* my bold guess is as a simple, plain sub... */ 348 /* my bold guess is as a simple, plain sub... */
238 croak ("CXt_FORMAT not yet handled. Don't switch coroutines from within formats"); 349 croak ("CXt_FORMAT not yet handled. Don't switch coroutines from within formats");
239 } 350 }
351#endif
240 } 352 }
241 353
242 if (top_si->si_type == PERLSI_MAIN) 354 if (top_si->si_type == PERLSI_MAIN)
243 break; 355 break;
244 356
… …
248 } 360 }
249 361
250 PUTBACK; 362 PUTBACK;
251 } 363 }
252 364
253 c->dowarn = PL_dowarn; 365 c->defav = flags & TRANSFER_SAVE_DEFAV ? (AV *)SvREFCNT_inc (GvAV (PL_defgv)) : 0;
254 c->defav = GvAV (PL_defgv); 366 c->defsv = flags & TRANSFER_SAVE_DEFSV ? SvREFCNT_inc (DEFSV) : 0;
255 c->curstackinfo = PL_curstackinfo; 367 c->errsv = flags & TRANSFER_SAVE_ERRSV ? SvREFCNT_inc (ERRSV) : 0;
256 c->curstack = PL_curstack; 368
257 c->mainstack = PL_mainstack; 369#define VAR(name,type)c->name = PL_ ## name;
258 c->stack_sp = PL_stack_sp; 370# include "state.h"
259 c->op = PL_op; 371#undef VAR
260 c->curpad = PL_curpad; 372}
373
374/*
375 * allocate various perl stacks. This is an exact copy
376 * of perl.c:init_stacks, except that it uses less memory
377 * on the (sometimes correct) assumption that coroutines do
378 * not usually need a lot of stackspace.
379 */
380static void
381coro_init_stacks ()
382{
383 PL_curstackinfo = new_stackinfo(96, 1024/sizeof(PERL_CONTEXT) - 1);
384 PL_curstackinfo->si_type = PERLSI_MAIN;
385 PL_curstack = PL_curstackinfo->si_stack;
386 PL_mainstack = PL_curstack; /* remember in case we switch stacks */
387
388 PL_stack_base = AvARRAY(PL_curstack);
261 c->stack_base = PL_stack_base; 389 PL_stack_sp = PL_stack_base;
262 c->stack_max = PL_stack_max; 390 PL_stack_max = PL_stack_base + AvMAX(PL_curstack);
263 c->tmps_stack = PL_tmps_stack;
264 c->tmps_floor = PL_tmps_floor;
265 c->tmps_ix = PL_tmps_ix;
266 c->tmps_max = PL_tmps_max;
267 c->markstack = PL_markstack;
268 c->markstack_ptr = PL_markstack_ptr;
269 c->markstack_max = PL_markstack_max;
270 c->scopestack = PL_scopestack;
271 c->scopestack_ix = PL_scopestack_ix;
272 c->scopestack_max = PL_scopestack_max;
273 c->savestack = PL_savestack;
274 c->savestack_ix = PL_savestack_ix;
275 c->savestack_max = PL_savestack_max;
276 c->retstack = PL_retstack;
277 c->retstack_ix = PL_retstack_ix;
278 c->retstack_max = PL_retstack_max;
279 c->curcop = PL_curcop;
280}
281 391
282static void 392 New(50,PL_tmps_stack,96,SV*);
283LOAD(pTHX_ Coro__State c) 393 PL_tmps_floor = -1;
284{ 394 PL_tmps_ix = -1;
285 PL_dowarn = c->dowarn; 395 PL_tmps_max = 96;
286 GvAV (PL_defgv) = c->defav; 396
287 PL_curstackinfo = c->curstackinfo; 397 New(54,PL_markstack,16,I32);
288 PL_curstack = c->curstack;
289 PL_mainstack = c->mainstack;
290 PL_stack_sp = c->stack_sp;
291 PL_op = c->op;
292 PL_curpad = c->curpad;
293 PL_stack_base = c->stack_base;
294 PL_stack_max = c->stack_max;
295 PL_tmps_stack = c->tmps_stack;
296 PL_tmps_floor = c->tmps_floor;
297 PL_tmps_ix = c->tmps_ix;
298 PL_tmps_max = c->tmps_max;
299 PL_markstack = c->markstack;
300 PL_markstack_ptr = c->markstack_ptr; 398 PL_markstack_ptr = PL_markstack;
301 PL_markstack_max = c->markstack_max; 399 PL_markstack_max = PL_markstack + 16;
302 PL_scopestack = c->scopestack;
303 PL_scopestack_ix = c->scopestack_ix;
304 PL_scopestack_max = c->scopestack_max;
305 PL_savestack = c->savestack;
306 PL_savestack_ix = c->savestack_ix;
307 PL_savestack_max = c->savestack_max;
308 PL_retstack = c->retstack;
309 PL_retstack_ix = c->retstack_ix;
310 PL_retstack_max = c->retstack_max;
311 PL_curcop = c->curcop;
312 400
313 { 401#ifdef SET_MARK_OFFSET
314 dSP; 402 SET_MARK_OFFSET;
315 CV *cv; 403#endif
316 404
317 /* now do the ugly restore mess */ 405 New(54,PL_scopestack,16,I32);
318 while ((cv = (CV *)POPs)) 406 PL_scopestack_ix = 0;
407 PL_scopestack_max = 16;
408
409 New(54,PL_savestack,96,ANY);
410 PL_savestack_ix = 0;
411 PL_savestack_max = 96;
412
413#if !PERL_VERSION_ATLEAST (5,9,0)
414 New(54,PL_retstack,8,OP*);
415 PL_retstack_ix = 0;
416 PL_retstack_max = 8;
417#endif
418}
419
420/*
421 * destroy the stacks, the callchain etc...
422 */
423static void
424coro_destroy_stacks ()
425{
426 if (!IN_DESTRUCT)
319 { 427 {
320 AV *padlist = (AV *)POPs;
321
322 put_padlist (cv);
323 CvPADLIST(cv) = padlist;
324 CvDEPTH(cv) = (I32)POPs;
325
326#ifdef USE_THREADS
327 CvOWNER(cv) = (struct perl_thread *)POPs;
328 error does not work either
329#endif
330 }
331
332 PUTBACK;
333 }
334}
335
336/* this is an EXACT copy of S_nuke_stacks in perl.c, which is unfortunately static */
337STATIC void
338destroy_stacks(pTHX)
339{
340 /* die does this while calling POPSTACK, but I just don't see why. */
341 dounwind(-1);
342
343 /* is this ugly, I ask? */ 428 /* is this ugly, I ask? */
344 while (PL_scopestack_ix) 429 LEAVE_SCOPE (0);
345 LEAVE; 430
431 /* sure it is, but more important: is it correct?? :/ */
432 FREETMPS;
433
434 /*POPSTACK_TO (PL_mainstack);*//*D*//*use*/
435 }
346 436
347 while (PL_curstackinfo->si_next) 437 while (PL_curstackinfo->si_next)
348 PL_curstackinfo = PL_curstackinfo->si_next; 438 PL_curstackinfo = PL_curstackinfo->si_next;
349 439
350 while (PL_curstackinfo) 440 while (PL_curstackinfo)
351 { 441 {
352 PERL_SI *p = PL_curstackinfo->si_prev; 442 PERL_SI *p = PL_curstackinfo->si_prev;
353 443
444 { /*D*//*remove*/
445 dSP;
446 SWITCHSTACK (PL_curstack, PL_curstackinfo->si_stack);
447 PUTBACK; /* possibly superfluous */
448 }
449
450 if (!IN_DESTRUCT)
451 {
452 dounwind (-1);/*D*//*remove*/
354 SvREFCNT_dec(PL_curstackinfo->si_stack); 453 SvREFCNT_dec (PL_curstackinfo->si_stack);
454 }
455
355 Safefree(PL_curstackinfo->si_cxstack); 456 Safefree (PL_curstackinfo->si_cxstack);
356 Safefree(PL_curstackinfo); 457 Safefree (PL_curstackinfo);
357 PL_curstackinfo = p; 458 PL_curstackinfo = p;
358 } 459 }
359 460
360 if (PL_scopestack_ix != 0) 461 Safefree (PL_tmps_stack);
361 Perl_warner(aTHX_ WARN_INTERNAL, 462 Safefree (PL_markstack);
362 "Unbalanced scopes: %ld more ENTERs than LEAVEs\n", 463 Safefree (PL_scopestack);
363 (long)PL_scopestack_ix); 464 Safefree (PL_savestack);
364 if (PL_savestack_ix != 0) 465#if !PERL_VERSION_ATLEAST (5,9,0)
365 Perl_warner(aTHX_ WARN_INTERNAL, 466 Safefree (PL_retstack);
366 "Unbalanced saves: %ld more saves than restores\n", 467#endif
367 (long)PL_savestack_ix); 468}
368 if (PL_tmps_floor != -1) 469
369 Perl_warner(aTHX_ WARN_INTERNAL,"Unbalanced tmps: %ld more allocs than frees\n", 470static void
370 (long)PL_tmps_floor + 1); 471setup_coro (struct coro *coro)
472{
371 /* 473 /*
372 */ 474 * emulate part of the perl startup here.
373 Safefree(PL_tmps_stack); 475 */
374 Safefree(PL_markstack);
375 Safefree(PL_scopestack);
376 Safefree(PL_savestack);
377 Safefree(PL_retstack);
378}
379 476
380#define SUB_INIT "Coro::State::_newcoro" 477 coro_init_stacks ();
478
479 PL_curcop = 0;
480 PL_in_eval = 0;
481 PL_curpm = 0;
482
483 {
484 dSP;
485 LOGOP myop;
486
487 /* I have no idea why this is needed, but it is */
488 PUSHMARK (SP);
489
490 SvREFCNT_dec (GvAV (PL_defgv));
491 GvAV (PL_defgv) = coro->args; coro->args = 0;
492
493 Zero (&myop, 1, LOGOP);
494 myop.op_next = Nullop;
495 myop.op_flags = OPf_WANT_VOID;
496
497 PL_op = (OP *)&myop;
498
499 PUSHMARK (SP);
500 XPUSHs ((SV *)get_cv ("Coro::State::_coro_init", FALSE));
501 PUTBACK;
502 PL_op = PL_ppaddr[OP_ENTERSUB](aTHX);
503 SPAGAIN;
504
505 ENTER; /* necessary e.g. for dounwind */
506 }
507}
508
509static void
510free_coro_mortal ()
511{
512 if (coro_mortal)
513 {
514 SvREFCNT_dec (coro_mortal);
515 coro_mortal = 0;
516 }
517}
518
519static void NOINLINE
520prepare_cctx (coro_cctx *cctx)
521{
522 dSP;
523 LOGOP myop;
524
525 Zero (&myop, 1, LOGOP);
526 myop.op_next = PL_op;
527 myop.op_flags = OPf_WANT_VOID;
528
529 sv_setiv (get_sv ("Coro::State::_cctx", FALSE), PTR2IV (cctx));
530
531 PUSHMARK (SP);
532 XPUSHs ((SV *)get_cv ("Coro::State::_cctx_init", FALSE));
533 PUTBACK;
534 PL_restartop = PL_ppaddr[OP_ENTERSUB](aTHX);
535 SPAGAIN;
536}
537
538static void
539coro_run (void *arg)
540{
541 /* coro_run is the alternative epilogue of transfer() */
542 UNLOCK;
543
544 /*
545 * this is a _very_ stripped down perl interpreter ;)
546 */
547 PL_top_env = &PL_start_env;
548
549 /* inject call to cctx_init */
550 prepare_cctx ((coro_cctx *)arg);
551
552 /* somebody will hit me for both perl_run and PL_restartop */
553 perl_run (PL_curinterp);
554
555 fputs ("FATAL: C coroutine fell over the edge of the world, aborting. Did you call exit in a coroutine?\n", stderr);
556 abort ();
557}
558
559static coro_cctx *
560cctx_new ()
561{
562 coro_cctx *cctx;
563
564 ++cctx_count;
565
566 New (0, cctx, 1, coro_cctx);
567
568#if HAVE_MMAP
569
570 cctx->ssize = ((STACKSIZE * sizeof (long) + PAGESIZE - 1) / PAGESIZE + STACKGUARD) * PAGESIZE;
571 /* mmap suppsedly does allocate-on-write for us */
572 cctx->sptr = mmap (0, cctx->ssize, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_PRIVATE|MAP_ANONYMOUS, 0, 0);
573
574 if (cctx->sptr == (void *)-1)
575 {
576 perror ("FATAL: unable to mmap stack for coroutine");
577 _exit (EXIT_FAILURE);
578 }
579
580# if STACKGUARD
581 mprotect (cctx->sptr, STACKGUARD * PAGESIZE, PROT_NONE);
582# endif
583
584#else
585
586 cctx->ssize = STACKSIZE * (long)sizeof (long);
587 New (0, cctx->sptr, STACKSIZE, long);
588
589 if (!cctx->sptr)
590 {
591 perror ("FATAL: unable to malloc stack for coroutine");
592 _exit (EXIT_FAILURE);
593 }
594
595#endif
596
597#if USE_VALGRIND
598 cctx->valgrind_id = VALGRIND_STACK_REGISTER (
599 STACKGUARD * PAGESIZE + (char *)cctx->sptr,
600 cctx->ssize + (char *)cctx->sptr
601 );
602#endif
603
604 coro_create (&cctx->cctx, coro_run, (void *)cctx, cctx->sptr, cctx->ssize);
605
606 return cctx;
607}
608
609static void
610cctx_free (coro_cctx *cctx)
611{
612 if (!cctx)
613 return;
614
615 --cctx_count;
616
617#if USE_VALGRIND
618 VALGRIND_STACK_DEREGISTER (cctx->valgrind_id);
619#endif
620
621#if HAVE_MMAP
622 munmap (cctx->sptr, cctx->ssize);
623#else
624 Safefree (cctx->sptr);
625#endif
626
627 Safefree (cctx);
628}
629
630static coro_cctx *
631cctx_get ()
632{
633 coro_cctx *cctx;
634
635 if (cctx_first)
636 {
637 --cctx_idle;
638 cctx = cctx_first;
639 cctx_first = cctx->next;
640 }
641 else
642 {
643 cctx = cctx_new ();
644 PL_op = PL_op->op_next;
645 }
646
647 return cctx;
648}
649
650static void
651cctx_put (coro_cctx *cctx)
652{
653 ++cctx_idle;
654 cctx->next = cctx_first;
655 cctx_first = cctx;
656}
657
658/* never call directly, always through the coro_state_transfer global variable */
659static void NOINLINE
660transfer (struct coro *prev, struct coro *next, int flags)
661{
662 dSTACKLEVEL;
663
664 /* sometimes transfer is only called to set idle_sp */
665 if (flags == TRANSFER_SET_STACKLEVEL)
666 ((coro_cctx *)prev)->idle_sp = STACKLEVEL;
667 else if (prev != next)
668 {
669 coro_cctx *prev__cctx;
670
671 LOCK;
672
673 if (next->mainstack)
674 {
675 /* coroutine already started */
676 SAVE (prev, flags);
677 LOAD (next);
678 }
679 else
680 {
681 /* need to start coroutine */
682 /* first get rid of the old state */
683 SAVE (prev, -1);
684 /* setup coroutine call */
685 setup_coro (next);
686 /* need a stack */
687 next->cctx = 0;
688 }
689
690 if (!prev->cctx)
691 /* create a new empty context */
692 Newz (0, prev->cctx, 1, coro_cctx);
693
694 prev__cctx = prev->cctx;
695
696 /* possibly "free" the cctx */
697 if (prev__cctx->idle_sp == STACKLEVEL)
698 {
699 assert (PL_top_env == prev__cctx->top_env);//D
700 cctx_put (prev__cctx);
701 prev->cctx = 0;
702 }
703
704 if (!next->cctx)
705 next->cctx = cctx_get ();
706
707 if (prev__cctx != next->cctx)
708 {
709 prev__cctx->top_env = PL_top_env;
710 PL_top_env = next->cctx->top_env;
711 coro_transfer (&prev__cctx->cctx, &next->cctx->cctx);
712 }
713
714 free_coro_mortal ();
715
716 UNLOCK;
717 }
718}
719
720struct transfer_args
721{
722 struct coro *prev, *next;
723 int flags;
724};
725
726#define TRANSFER(ta) transfer ((ta).prev, (ta).next, (ta).flags)
727
728static void
729coro_state_destroy (struct coro *coro)
730{
731 if (coro->refcnt--)
732 return;
733
734 if (coro->mainstack && coro->mainstack != main_mainstack)
735 {
736 struct coro temp;
737
738 SAVE ((&temp), TRANSFER_SAVE_ALL);
739 LOAD (coro);
740
741 coro_destroy_stacks ();
742
743 LOAD ((&temp)); /* this will get rid of defsv etc.. */
744
745 coro->mainstack = 0;
746 }
747
748 cctx_free (coro->cctx);
749 SvREFCNT_dec (coro->args);
750 Safefree (coro);
751}
752
753static int
754coro_state_clear (pTHX_ SV *sv, MAGIC *mg)
755{
756 struct coro *coro = (struct coro *)mg->mg_ptr;
757 mg->mg_ptr = 0;
758
759 coro_state_destroy (coro);
760
761 return 0;
762}
763
764static int
765coro_state_dup (pTHX_ MAGIC *mg, CLONE_PARAMS *params)
766{
767 struct coro *coro = (struct coro *)mg->mg_ptr;
768
769 ++coro->refcnt;
770
771 return 0;
772}
773
774static MGVTBL coro_state_vtbl = {
775 0, 0, 0, 0,
776 coro_state_clear,
777 0,
778#ifdef MGf_DUP
779 coro_state_dup,
780#else
781# define MGf_DUP 0
782#endif
783};
784
785static struct coro *
786SvSTATE (SV *coro)
787{
788 HV *stash;
789 MAGIC *mg;
790
791 if (SvROK (coro))
792 coro = SvRV (coro);
793
794 stash = SvSTASH (coro);
795 if (stash != coro_stash && stash != coro_state_stash)
796 {
797 /* very slow, but rare, check */
798 if (!sv_derived_from (sv_2mortal (newRV_inc (coro)), "Coro::State"))
799 croak ("Coro::State object required");
800 }
801
802 mg = SvMAGIC (coro);
803 assert (mg->mg_type == PERL_MAGIC_ext);
804 return (struct coro *)mg->mg_ptr;
805}
806
807static void
808prepare_transfer (struct transfer_args *ta, SV *prev, SV *next, int flags)
809{
810 ta->prev = SvSTATE (prev);
811 ta->next = SvSTATE (next);
812 ta->flags = flags;
813}
814
815static void
816api_transfer (SV *prev, SV *next, int flags)
817{
818 dTHX;
819 struct transfer_args ta;
820
821 prepare_transfer (&ta, prev, next, flags);
822 TRANSFER (ta);
823}
824
825/** Coro ********************************************************************/
826
827#define PRIO_MAX 3
828#define PRIO_HIGH 1
829#define PRIO_NORMAL 0
830#define PRIO_LOW -1
831#define PRIO_IDLE -3
832#define PRIO_MIN -4
833
834/* for Coro.pm */
835static GV *coro_current, *coro_idle;
836static AV *coro_ready [PRIO_MAX-PRIO_MIN+1];
837static int coro_nready;
838
839static void
840coro_enq (SV *sv)
841{
842 int prio;
843
844 if (SvTYPE (sv) != SVt_PVHV)
845 croak ("Coro::ready tried to enqueue something that is not a coroutine");
846
847 prio = SvSTATE (sv)->prio;
848
849 av_push (coro_ready [prio - PRIO_MIN], sv);
850 coro_nready++;
851}
852
853static SV *
854coro_deq (int min_prio)
855{
856 int prio = PRIO_MAX - PRIO_MIN;
857
858 min_prio -= PRIO_MIN;
859 if (min_prio < 0)
860 min_prio = 0;
861
862 for (prio = PRIO_MAX - PRIO_MIN + 1; --prio >= min_prio; )
863 if (AvFILLp (coro_ready [prio]) >= 0)
864 {
865 coro_nready--;
866 return av_shift (coro_ready [prio]);
867 }
868
869 return 0;
870}
871
872static void
873api_ready (SV *coro)
874{
875 dTHX;
876
877 if (SvROK (coro))
878 coro = SvRV (coro);
879
880 LOCK;
881 coro_enq (SvREFCNT_inc (coro));
882 UNLOCK;
883}
884
885static void
886prepare_schedule (struct transfer_args *ta)
887{
888 SV *current, *prev, *next;
889
890 current = GvSV (coro_current);
891
892 for (;;)
893 {
894 LOCK;
895 next = coro_deq (PRIO_MIN);
896 UNLOCK;
897
898 if (next)
899 break;
900
901 {
902 dSP;
903
904 ENTER;
905 SAVETMPS;
906
907 PUSHMARK (SP);
908 PUTBACK;
909 call_sv (GvSV (coro_idle), G_DISCARD);
910
911 FREETMPS;
912 LEAVE;
913 }
914 }
915
916 prev = SvRV (current);
917 SvRV (current) = next;
918
919 /* free this only after the transfer */
920 LOCK;
921 free_coro_mortal ();
922 UNLOCK;
923 coro_mortal = prev;
924
925 ta->prev = SvSTATE (prev);
926 ta->next = SvSTATE (next);
927 ta->flags = TRANSFER_SAVE_ALL;
928}
929
930static void
931prepare_cede (struct transfer_args *ta)
932{
933 LOCK;
934 coro_enq (SvREFCNT_inc (SvRV (GvSV (coro_current))));
935 UNLOCK;
936
937 prepare_schedule (ta);
938}
939
940static void
941api_schedule (void)
942{
943 dTHX;
944 struct transfer_args ta;
945
946 prepare_schedule (&ta);
947 TRANSFER (ta);
948}
949
950static void
951api_cede (void)
952{
953 dTHX;
954 struct transfer_args ta;
955
956 prepare_cede (&ta);
957 TRANSFER (ta);
958}
381 959
382MODULE = Coro::State PACKAGE = Coro::State 960MODULE = Coro::State PACKAGE = Coro::State
383 961
384PROTOTYPES: ENABLE 962PROTOTYPES: DISABLE
385 963
386BOOT: 964BOOT:
387 if (!padlist_cache) 965{
388 padlist_cache = newHV (); 966#ifdef USE_ITHREADS
967 MUTEX_INIT (&coro_mutex);
968#endif
969 BOOT_PAGESIZE;
389 970
390Coro::State 971 coro_state_stash = gv_stashpv ("Coro::State", TRUE);
391_newprocess(args) 972
392 SV * args 973 newCONSTSUB (coro_state_stash, "SAVE_DEFAV", newSViv (TRANSFER_SAVE_DEFAV));
393 PROTOTYPE: $ 974 newCONSTSUB (coro_state_stash, "SAVE_DEFSV", newSViv (TRANSFER_SAVE_DEFSV));
975 newCONSTSUB (coro_state_stash, "SAVE_ERRSV", newSViv (TRANSFER_SAVE_ERRSV));
976
977 main_mainstack = PL_mainstack;
978
979 coroapi.ver = CORO_API_VERSION;
980 coroapi.transfer = api_transfer;
981
982 assert (("PRIO_NORMAL must be 0", !PRIO_NORMAL));
983}
984
985SV *
986new (char *klass, ...)
394 CODE: 987 CODE:
395 Coro__State coro; 988{
989 struct coro *coro;
990 HV *hv;
991 int i;
396 992
397 if (!SvROK (args) || SvTYPE (SvRV (args)) != SVt_PVAV)
398 croak ("Coro::State::newprocess expects an arrayref");
399
400 New (0, coro, 1, struct coro); 993 Newz (0, coro, 1, struct coro);
994 coro->args = newAV ();
401 995
402 coro->mainstack = 0; /* actual work is done inside transfer */ 996 hv = newHV ();
403 coro->args = (AV *)SvREFCNT_inc (SvRV (args)); 997 sv_magicext ((SV *)hv, 0, PERL_MAGIC_ext, &coro_state_vtbl, (char *)coro, 0)->mg_flags |= MGf_DUP;
998 RETVAL = sv_bless (newRV_noinc ((SV *)hv), gv_stashpv (klass, 1));
404 999
405 RETVAL = coro; 1000 for (i = 1; i < items; i++)
1001 av_push (coro->args, newSVsv (ST (i)));
1002}
406 OUTPUT: 1003 OUTPUT:
407 RETVAL 1004 RETVAL
408 1005
409void 1006void
410transfer(prev,next) 1007_set_stacklevel (...)
411 Coro::State_or_hashref prev 1008 ALIAS:
412 Coro::State_or_hashref next 1009 Coro::State::transfer = 1
1010 Coro::schedule = 2
1011 Coro::cede = 3
1012 Coro::Cont::yield = 4
413 CODE: 1013 CODE:
1014{
1015 struct transfer_args ta;
414 1016
415 if (prev != next) 1017 switch (ix)
416 { 1018 {
417 PUTBACK; 1019 case 0:
418 SAVE (aTHX_ prev); 1020 ta.prev = (struct coro *)INT2PTR (coro_cctx *, SvIV (ST (0)));
1021 ta.next = 0;
1022 ta.flags = TRANSFER_SET_STACKLEVEL;
1023 break;
419 1024
420 /* 1025 case 1:
421 * this could be done in newprocess which would lead to 1026 if (items != 3)
422 * extremely elegant and fast (just PUTBACK/SAVE/LOAD/SPAGAIN) 1027 croak ("Coro::State::transfer(prev,next,flags) expects three arguments, not %d", items);
423 * code here, but lazy allocation of stacks has also 1028
424 * some virtues and the overhead of the if() is nil. 1029 prepare_transfer (&ta, ST (0), ST (1), SvIV (ST (2)));
425 */ 1030 break;
426 if (next->mainstack) 1031
1032 case 2:
1033 prepare_schedule (&ta);
1034 break;
1035
1036 case 3:
1037 prepare_cede (&ta);
1038 break;
1039
1040 case 4:
427 { 1041 {
428 LOAD (aTHX_ next); 1042 SV *yieldstack;
429 next->mainstack = 0; /* unnecessary but much cleaner */ 1043 SV *sv;
1044 AV *defav = GvAV (PL_defgv);
1045
1046 yieldstack = *hv_fetch (
1047 (HV *)SvRV (GvSV (coro_current)),
1048 "yieldstack", sizeof ("yieldstack") - 1,
1049 0
430 SPAGAIN; 1050 );
1051
1052 /* set up @_ -- ugly */
1053 av_clear (defav);
1054 av_fill (defav, items - 1);
1055 while (items--)
1056 av_store (defav, items, SvREFCNT_inc (ST(items)));
1057
1058 sv = av_pop ((AV *)SvRV (yieldstack));
1059 ta.prev = SvSTATE (*av_fetch ((AV *)SvRV (sv), 0, 0));
1060 ta.next = SvSTATE (*av_fetch ((AV *)SvRV (sv), 1, 0));
1061 ta.flags = 0;
1062 SvREFCNT_dec (sv);
431 } 1063 }
432 else 1064 break;
433 {
434 /*
435 * emulate part of the perl startup here.
436 */
437 UNOP myop;
438 1065
439 init_stacks (); /* from perl.c */
440 PL_op = (OP *)&myop;
441 /*PL_curcop = 0;*/
442 GvAV (PL_defgv) = (AV *)SvREFCNT_inc ((SV *)next->args);
443
444 SPAGAIN;
445 Zero(&myop, 1, UNOP);
446 myop.op_next = Nullop;
447 myop.op_flags = OPf_WANT_VOID;
448
449 PUSHMARK(SP);
450 XPUSHs ((SV*)get_cv(SUB_INIT, TRUE));
451 PUTBACK;
452 /*
453 * the next line is slightly wrong, as PL_op->op_next
454 * is actually being executed so we skip the first op.
455 * that doesn't matter, though, since it is only
456 * pp_nextstate and we never return...
457 */
458 PL_op = Perl_pp_entersub(aTHX);
459 SPAGAIN;
460
461 ENTER;
462 }
463 } 1066 }
464 1067
1068 TRANSFER (ta);
1069}
1070
465void 1071void
466DESTROY(coro) 1072_clone_state_from (SV *dst, SV *src)
467 Coro::State coro 1073 CODE:
1074{
1075 struct coro *coro_src = SvSTATE (src);
1076
1077 sv_unmagic (SvRV (dst), PERL_MAGIC_ext);
1078
1079 ++coro_src->refcnt;
1080 sv_magicext (SvRV (dst), 0, PERL_MAGIC_ext, &coro_state_vtbl, (char *)coro_src, 0)->mg_flags |= MGf_DUP;
1081}
1082
1083void
1084_exit (code)
1085 int code
1086 PROTOTYPE: $
1087 CODE:
1088 _exit (code);
1089
1090int
1091cctx_count ()
1092 CODE:
1093 RETVAL = cctx_count;
1094 OUTPUT:
1095 RETVAL
1096
1097int
1098cctx_idle ()
1099 CODE:
1100 RETVAL = cctx_idle;
1101 OUTPUT:
1102 RETVAL
1103
1104MODULE = Coro::State PACKAGE = Coro
1105
1106BOOT:
1107{
1108 int i;
1109
1110 coro_stash = gv_stashpv ("Coro", TRUE);
1111
1112 newCONSTSUB (coro_stash, "PRIO_MAX", newSViv (PRIO_MAX));
1113 newCONSTSUB (coro_stash, "PRIO_HIGH", newSViv (PRIO_HIGH));
1114 newCONSTSUB (coro_stash, "PRIO_NORMAL", newSViv (PRIO_NORMAL));
1115 newCONSTSUB (coro_stash, "PRIO_LOW", newSViv (PRIO_LOW));
1116 newCONSTSUB (coro_stash, "PRIO_IDLE", newSViv (PRIO_IDLE));
1117 newCONSTSUB (coro_stash, "PRIO_MIN", newSViv (PRIO_MIN));
1118
1119 coro_current = gv_fetchpv ("Coro::current", TRUE, SVt_PV);
1120 coro_idle = gv_fetchpv ("Coro::idle" , TRUE, SVt_PV);
1121
1122 for (i = PRIO_MAX - PRIO_MIN + 1; i--; )
1123 coro_ready[i] = newAV ();
1124
1125 {
1126 SV *sv = perl_get_sv("Coro::API", 1);
1127
1128 coroapi.schedule = api_schedule;
1129 coroapi.cede = api_cede;
1130 coroapi.ready = api_ready;
1131 coroapi.nready = &coro_nready;
1132 coroapi.current = coro_current;
1133
1134 GCoroAPI = &coroapi;
1135 sv_setiv (sv, (IV)&coroapi);
1136 SvREADONLY_on (sv);
1137 }
1138}
1139
1140int
1141prio (Coro::State coro, int newprio = 0)
1142 ALIAS:
1143 nice = 1
468 CODE: 1144 CODE:
1145{
1146 RETVAL = coro->prio;
469 1147
470 if (coro->mainstack) 1148 if (items > 1)
471 { 1149 {
472 struct coro temp; 1150 if (ix)
1151 newprio += coro->prio;
473 1152
474 PUTBACK; 1153 if (newprio < PRIO_MIN) newprio = PRIO_MIN;
475 SAVE(aTHX_ (&temp)); 1154 if (newprio > PRIO_MAX) newprio = PRIO_MAX;
476 LOAD(aTHX_ coro);
477 1155
478 destroy_stacks (); 1156 coro->prio = newprio;
479 SvREFCNT_dec ((SV *)GvAV (PL_defgv));
480
481 LOAD((&temp));
482 SPAGAIN;
483 } 1157 }
1158}
484 1159
485 SvREFCNT_dec (coro->args); 1160void
486 Safefree (coro); 1161ready (SV *self)
1162 PROTOTYPE: $
1163 CODE:
1164 api_ready (self);
487 1165
1166int
1167nready (...)
1168 PROTOTYPE:
1169 CODE:
1170 RETVAL = coro_nready;
1171 OUTPUT:
1172 RETVAL
488 1173
1174MODULE = Coro::State PACKAGE = Coro::AIO
1175
1176SV *
1177_get_state ()
1178 CODE:
1179{
1180 struct {
1181 int errorno;
1182 int laststype;
1183 int laststatval;
1184 Stat_t statcache;
1185 } data;
1186
1187 data.errorno = errno;
1188 data.laststype = PL_laststype;
1189 data.laststatval = PL_laststatval;
1190 data.statcache = PL_statcache;
1191
1192 RETVAL = newSVpvn ((char *)&data, sizeof data);
1193}
1194 OUTPUT:
1195 RETVAL
1196
1197void
1198_set_state (char *data_)
1199 PROTOTYPE: $
1200 CODE:
1201{
1202 struct {
1203 int errorno;
1204 int laststype;
1205 int laststatval;
1206 Stat_t statcache;
1207 } *data = (void *)data_;
1208
1209 errno = data->errorno;
1210 PL_laststype = data->laststype;
1211 PL_laststatval = data->laststatval;
1212 PL_statcache = data->statcache;
1213}

Diff Legend

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