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.4 by root, Tue Jul 17 02:21:56 2001 UTC vs.
Revision 1.109 by root, Mon Nov 27 18:45:29 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 dSP;
341
342 /* die does this while calling POPSTACK, but I just don't see why. */
343 dounwind(-1);
344
345 /* is this ugly, I ask? */ 428 /* is this ugly, I ask? */
346 while (PL_scopestack_ix) 429 LEAVE_SCOPE (0);
347 LEAVE; 430
431 /* sure it is, but more important: is it correct?? :/ */
432 FREETMPS;
433
434 /*POPSTACK_TO (PL_mainstack);*//*D*//*use*/
435 }
348 436
349 while (PL_curstackinfo->si_next) 437 while (PL_curstackinfo->si_next)
350 PL_curstackinfo = PL_curstackinfo->si_next; 438 PL_curstackinfo = PL_curstackinfo->si_next;
351 439
352 while (PL_curstackinfo) 440 while (PL_curstackinfo)
353 { 441 {
354 PERL_SI *p = PL_curstackinfo->si_prev; 442 PERL_SI *p = PL_curstackinfo->si_prev;
355 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*/
356 SvREFCNT_dec(PL_curstackinfo->si_stack); 453 SvREFCNT_dec (PL_curstackinfo->si_stack);
454 }
455
357 Safefree(PL_curstackinfo->si_cxstack); 456 Safefree (PL_curstackinfo->si_cxstack);
358 Safefree(PL_curstackinfo); 457 Safefree (PL_curstackinfo);
359 PL_curstackinfo = p; 458 PL_curstackinfo = p;
360 } 459 }
361 460
362 if (PL_scopestack_ix != 0) 461 Safefree (PL_tmps_stack);
363 Perl_warner(aTHX_ WARN_INTERNAL, 462 Safefree (PL_markstack);
364 "Unbalanced scopes: %ld more ENTERs than LEAVEs\n", 463 Safefree (PL_scopestack);
365 (long)PL_scopestack_ix); 464 Safefree (PL_savestack);
366 if (PL_savestack_ix != 0) 465#if !PERL_VERSION_ATLEAST (5,9,0)
367 Perl_warner(aTHX_ WARN_INTERNAL, 466 Safefree (PL_retstack);
368 "Unbalanced saves: %ld more saves than restores\n", 467#endif
369 (long)PL_savestack_ix); 468}
370 if (PL_tmps_floor != -1) 469
371 Perl_warner(aTHX_ WARN_INTERNAL,"Unbalanced tmps: %ld more allocs than frees\n", 470static void
372 (long)PL_tmps_floor + 1); 471setup_coro (struct coro *coro)
472{
373 /* 473 /*
374 */ 474 * emulate part of the perl startup here.
375 Safefree(PL_tmps_stack); 475 */
376 Safefree(PL_markstack);
377 Safefree(PL_scopestack);
378 Safefree(PL_savestack);
379 Safefree(PL_retstack);
380}
381 476
382#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 cctx_put (prev__cctx);
700 prev->cctx = 0;
701 }
702
703 if (!next->cctx)
704 next->cctx = cctx_get ();
705
706 if (prev__cctx != next->cctx)
707 {
708 prev__cctx->top_env = PL_top_env;
709 PL_top_env = next->cctx->top_env;
710 coro_transfer (&prev__cctx->cctx, &next->cctx->cctx);
711 }
712
713 free_coro_mortal ();
714
715 UNLOCK;
716 }
717}
718
719struct transfer_args
720{
721 struct coro *prev, *next;
722 int flags;
723};
724
725#define TRANSFER(ta) transfer ((ta).prev, (ta).next, (ta).flags)
726
727static void
728coro_state_destroy (struct coro *coro)
729{
730 if (coro->refcnt--)
731 return;
732
733 if (coro->mainstack && coro->mainstack != main_mainstack)
734 {
735 struct coro temp;
736
737 SAVE ((&temp), TRANSFER_SAVE_ALL);
738 LOAD (coro);
739
740 coro_destroy_stacks ();
741
742 LOAD ((&temp)); /* this will get rid of defsv etc.. */
743
744 coro->mainstack = 0;
745 }
746
747 cctx_free (coro->cctx);
748 SvREFCNT_dec (coro->args);
749 Safefree (coro);
750}
751
752static int
753coro_state_clear (pTHX_ SV *sv, MAGIC *mg)
754{
755 struct coro *coro = (struct coro *)mg->mg_ptr;
756 mg->mg_ptr = 0;
757
758 coro_state_destroy (coro);
759
760 return 0;
761}
762
763static int
764coro_state_dup (pTHX_ MAGIC *mg, CLONE_PARAMS *params)
765{
766 struct coro *coro = (struct coro *)mg->mg_ptr;
767
768 ++coro->refcnt;
769
770 return 0;
771}
772
773static MGVTBL coro_state_vtbl = {
774 0, 0, 0, 0,
775 coro_state_clear,
776 0,
777#ifdef MGf_DUP
778 coro_state_dup,
779#else
780# define MGf_DUP 0
781#endif
782};
783
784static struct coro *
785SvSTATE (SV *coro)
786{
787 HV *stash;
788 MAGIC *mg;
789
790 if (SvROK (coro))
791 coro = SvRV (coro);
792
793 stash = SvSTASH (coro);
794 if (stash != coro_stash && stash != coro_state_stash)
795 {
796 /* very slow, but rare, check */
797 if (!sv_derived_from (sv_2mortal (newRV_inc (coro)), "Coro::State"))
798 croak ("Coro::State object required");
799 }
800
801 mg = SvMAGIC (coro);
802 assert (mg->mg_type == PERL_MAGIC_ext);
803 return (struct coro *)mg->mg_ptr;
804}
805
806static void
807prepare_transfer (struct transfer_args *ta, SV *prev, SV *next, int flags)
808{
809 ta->prev = SvSTATE (prev);
810 ta->next = SvSTATE (next);
811 ta->flags = flags;
812}
813
814static void
815api_transfer (SV *prev, SV *next, int flags)
816{
817 dTHX;
818 struct transfer_args ta;
819
820 prepare_transfer (&ta, prev, next, flags);
821 TRANSFER (ta);
822}
823
824/** Coro ********************************************************************/
825
826#define PRIO_MAX 3
827#define PRIO_HIGH 1
828#define PRIO_NORMAL 0
829#define PRIO_LOW -1
830#define PRIO_IDLE -3
831#define PRIO_MIN -4
832
833/* for Coro.pm */
834static GV *coro_current, *coro_idle;
835static AV *coro_ready [PRIO_MAX-PRIO_MIN+1];
836static int coro_nready;
837
838static void
839coro_enq (SV *sv)
840{
841 int prio;
842
843 if (SvTYPE (sv) != SVt_PVHV)
844 croak ("Coro::ready tried to enqueue something that is not a coroutine");
845
846 prio = SvSTATE (sv)->prio;
847
848 av_push (coro_ready [prio - PRIO_MIN], sv);
849 coro_nready++;
850}
851
852static SV *
853coro_deq (int min_prio)
854{
855 int prio = PRIO_MAX - PRIO_MIN;
856
857 min_prio -= PRIO_MIN;
858 if (min_prio < 0)
859 min_prio = 0;
860
861 for (prio = PRIO_MAX - PRIO_MIN + 1; --prio >= min_prio; )
862 if (AvFILLp (coro_ready [prio]) >= 0)
863 {
864 coro_nready--;
865 return av_shift (coro_ready [prio]);
866 }
867
868 return 0;
869}
870
871static void
872api_ready (SV *coro)
873{
874 dTHX;
875
876 if (SvROK (coro))
877 coro = SvRV (coro);
878
879 LOCK;
880 coro_enq (SvREFCNT_inc (coro));
881 UNLOCK;
882}
883
884static void
885prepare_schedule (struct transfer_args *ta)
886{
887 SV *current, *prev, *next;
888
889 current = GvSV (coro_current);
890
891 for (;;)
892 {
893 LOCK;
894 next = coro_deq (PRIO_MIN);
895 UNLOCK;
896
897 if (next)
898 break;
899
900 {
901 dSP;
902
903 ENTER;
904 SAVETMPS;
905
906 PUSHMARK (SP);
907 PUTBACK;
908 call_sv (GvSV (coro_idle), G_DISCARD);
909
910 FREETMPS;
911 LEAVE;
912 }
913 }
914
915 prev = SvRV (current);
916 SvRV (current) = next;
917
918 /* free this only after the transfer */
919 LOCK;
920 free_coro_mortal ();
921 UNLOCK;
922 coro_mortal = prev;
923
924 ta->prev = SvSTATE (prev);
925 ta->next = SvSTATE (next);
926 ta->flags = TRANSFER_SAVE_ALL;
927}
928
929static void
930prepare_cede (struct transfer_args *ta)
931{
932 LOCK;
933 coro_enq (SvREFCNT_inc (SvRV (GvSV (coro_current))));
934 UNLOCK;
935
936 prepare_schedule (ta);
937}
938
939static void
940api_schedule (void)
941{
942 dTHX;
943 struct transfer_args ta;
944
945 prepare_schedule (&ta);
946 TRANSFER (ta);
947}
948
949static void
950api_cede (void)
951{
952 dTHX;
953 struct transfer_args ta;
954
955 prepare_cede (&ta);
956 TRANSFER (ta);
957}
383 958
384MODULE = Coro::State PACKAGE = Coro::State 959MODULE = Coro::State PACKAGE = Coro::State
385 960
386PROTOTYPES: ENABLE 961PROTOTYPES: DISABLE
387 962
388BOOT: 963BOOT:
389 if (!padlist_cache) 964{
390 padlist_cache = newHV (); 965#ifdef USE_ITHREADS
966 MUTEX_INIT (&coro_mutex);
967#endif
968 BOOT_PAGESIZE;
391 969
392Coro::State 970 coro_state_stash = gv_stashpv ("Coro::State", TRUE);
393_newprocess(args) 971
394 SV * args 972 newCONSTSUB (coro_state_stash, "SAVE_DEFAV", newSViv (TRANSFER_SAVE_DEFAV));
395 PROTOTYPE: $ 973 newCONSTSUB (coro_state_stash, "SAVE_DEFSV", newSViv (TRANSFER_SAVE_DEFSV));
974 newCONSTSUB (coro_state_stash, "SAVE_ERRSV", newSViv (TRANSFER_SAVE_ERRSV));
975
976 main_mainstack = PL_mainstack;
977
978 coroapi.ver = CORO_API_VERSION;
979 coroapi.transfer = api_transfer;
980
981 assert (("PRIO_NORMAL must be 0", !PRIO_NORMAL));
982}
983
984SV *
985new (char *klass, ...)
396 CODE: 986 CODE:
397 Coro__State coro; 987{
988 struct coro *coro;
989 HV *hv;
990 int i;
398 991
399 if (!SvROK (args) || SvTYPE (SvRV (args)) != SVt_PVAV)
400 croak ("Coro::State::newprocess expects an arrayref");
401
402 New (0, coro, 1, struct coro); 992 Newz (0, coro, 1, struct coro);
993 coro->args = newAV ();
403 994
404 coro->mainstack = 0; /* actual work is done inside transfer */ 995 hv = newHV ();
405 coro->args = (AV *)SvREFCNT_inc (SvRV (args)); 996 sv_magicext ((SV *)hv, 0, PERL_MAGIC_ext, &coro_state_vtbl, (char *)coro, 0)->mg_flags |= MGf_DUP;
997 RETVAL = sv_bless (newRV_noinc ((SV *)hv), gv_stashpv (klass, 1));
406 998
407 RETVAL = coro; 999 for (i = 1; i < items; i++)
1000 av_push (coro->args, newSVsv (ST (i)));
1001}
408 OUTPUT: 1002 OUTPUT:
409 RETVAL 1003 RETVAL
410 1004
411void 1005void
412transfer(prev,next) 1006_set_stacklevel (...)
413 Coro::State_or_hashref prev 1007 ALIAS:
414 Coro::State_or_hashref next 1008 Coro::State::transfer = 1
1009 Coro::schedule = 2
1010 Coro::cede = 3
1011 Coro::Cont::yield = 4
415 CODE: 1012 CODE:
1013{
1014 struct transfer_args ta;
416 1015
417 if (prev != next) 1016 switch (ix)
418 { 1017 {
419 PUTBACK; 1018 case 0:
420 SAVE (aTHX_ prev); 1019 ta.prev = (struct coro *)INT2PTR (coro_cctx *, SvIV (ST (0)));
1020 ta.next = 0;
1021 ta.flags = TRANSFER_SET_STACKLEVEL;
1022 break;
421 1023
422 /* 1024 case 1:
423 * this could be done in newprocess which would lead to 1025 if (items != 3)
424 * extremely elegant and fast (just PUTBACK/SAVE/LOAD/SPAGAIN) 1026 croak ("Coro::State::transfer(prev,next,flags) expects three arguments, not %d", items);
425 * code here, but lazy allocation of stacks has also 1027
426 * some virtues and the overhead of the if() is nil. 1028 prepare_transfer (&ta, ST (0), ST (1), SvIV (ST (2)));
427 */ 1029 break;
428 if (next->mainstack) 1030
1031 case 2:
1032 prepare_schedule (&ta);
1033 break;
1034
1035 case 3:
1036 prepare_cede (&ta);
1037 break;
1038
1039 case 4:
429 { 1040 {
430 LOAD (aTHX_ next); 1041 SV *yieldstack;
431 next->mainstack = 0; /* unnecessary but much cleaner */ 1042 SV *sv;
1043 AV *defav = GvAV (PL_defgv);
1044
1045 yieldstack = *hv_fetch (
1046 (HV *)SvRV (GvSV (coro_current)),
1047 "yieldstack", sizeof ("yieldstack") - 1,
1048 0
432 SPAGAIN; 1049 );
1050
1051 /* set up @_ -- ugly */
1052 av_clear (defav);
1053 av_fill (defav, items - 1);
1054 while (items--)
1055 av_store (defav, items, SvREFCNT_inc (ST(items)));
1056
1057 sv = av_pop ((AV *)SvRV (yieldstack));
1058 ta.prev = SvSTATE (*av_fetch ((AV *)SvRV (sv), 0, 0));
1059 ta.next = SvSTATE (*av_fetch ((AV *)SvRV (sv), 1, 0));
1060 ta.flags = 0;
1061 SvREFCNT_dec (sv);
433 } 1062 }
434 else 1063 break;
435 {
436 /*
437 * emulate part of the perl startup here.
438 */
439 UNOP myop;
440 1064
441 init_stacks (); /* from perl.c */
442 PL_op = (OP *)&myop;
443 /*PL_curcop = 0;*/
444 GvAV (PL_defgv) = (SV *)SvREFCNT_inc (next->args);
445
446 SPAGAIN;
447 Zero(&myop, 1, UNOP);
448 myop.op_next = Nullop;
449 myop.op_flags = OPf_WANT_VOID;
450
451 PUSHMARK(SP);
452 XPUSHs ((SV*)get_cv(SUB_INIT, TRUE));
453 PUTBACK;
454 /*
455 * the next line is slightly wrong, as PL_op->op_next
456 * is actually being executed so we skip the first op.
457 * that doesn't matter, though, since it is only
458 * pp_nextstate and we never return...
459 */
460 PL_op = Perl_pp_entersub(aTHX);
461 SPAGAIN;
462
463 ENTER;
464 }
465 } 1065 }
466 1066
1067 TRANSFER (ta);
1068}
1069
467void 1070void
468DESTROY(coro) 1071_clone_state_from (SV *dst, SV *src)
469 Coro::State coro 1072 CODE:
1073{
1074 struct coro *coro_src = SvSTATE (src);
1075
1076 sv_unmagic (SvRV (dst), PERL_MAGIC_ext);
1077
1078 ++coro_src->refcnt;
1079 sv_magicext (SvRV (dst), 0, PERL_MAGIC_ext, &coro_state_vtbl, (char *)coro_src, 0)->mg_flags |= MGf_DUP;
1080}
1081
1082void
1083_exit (code)
1084 int code
1085 PROTOTYPE: $
1086 CODE:
1087 _exit (code);
1088
1089int
1090cctx_count ()
1091 CODE:
1092 RETVAL = cctx_count;
1093 OUTPUT:
1094 RETVAL
1095
1096int
1097cctx_idle ()
1098 CODE:
1099 RETVAL = cctx_idle;
1100 OUTPUT:
1101 RETVAL
1102
1103MODULE = Coro::State PACKAGE = Coro
1104
1105BOOT:
1106{
1107 int i;
1108
1109 coro_stash = gv_stashpv ("Coro", TRUE);
1110
1111 newCONSTSUB (coro_stash, "PRIO_MAX", newSViv (PRIO_MAX));
1112 newCONSTSUB (coro_stash, "PRIO_HIGH", newSViv (PRIO_HIGH));
1113 newCONSTSUB (coro_stash, "PRIO_NORMAL", newSViv (PRIO_NORMAL));
1114 newCONSTSUB (coro_stash, "PRIO_LOW", newSViv (PRIO_LOW));
1115 newCONSTSUB (coro_stash, "PRIO_IDLE", newSViv (PRIO_IDLE));
1116 newCONSTSUB (coro_stash, "PRIO_MIN", newSViv (PRIO_MIN));
1117
1118 coro_current = gv_fetchpv ("Coro::current", TRUE, SVt_PV);
1119 coro_idle = gv_fetchpv ("Coro::idle" , TRUE, SVt_PV);
1120
1121 for (i = PRIO_MAX - PRIO_MIN + 1; i--; )
1122 coro_ready[i] = newAV ();
1123
1124 {
1125 SV *sv = perl_get_sv("Coro::API", 1);
1126
1127 coroapi.schedule = api_schedule;
1128 coroapi.cede = api_cede;
1129 coroapi.ready = api_ready;
1130 coroapi.nready = &coro_nready;
1131 coroapi.current = coro_current;
1132
1133 GCoroAPI = &coroapi;
1134 sv_setiv (sv, (IV)&coroapi);
1135 SvREADONLY_on (sv);
1136 }
1137}
1138
1139int
1140prio (Coro::State coro, int newprio = 0)
1141 ALIAS:
1142 nice = 1
470 CODE: 1143 CODE:
1144{
1145 RETVAL = coro->prio;
471 1146
472 if (coro->mainstack) 1147 if (items > 1)
473 { 1148 {
474 struct coro temp; 1149 if (ix)
1150 newprio += coro->prio;
475 1151
476 PUTBACK; 1152 if (newprio < PRIO_MIN) newprio = PRIO_MIN;
477 SAVE(aTHX_ (&temp)); 1153 if (newprio > PRIO_MAX) newprio = PRIO_MAX;
478 LOAD(aTHX_ coro);
479 1154
480 destroy_stacks (); 1155 coro->prio = newprio;
481 SvREFCNT_dec ((SV *)GvAV (PL_defgv));
482
483 LOAD((&temp));
484 SPAGAIN;
485 } 1156 }
1157}
486 1158
487 SvREFCNT_dec (coro->args); 1159void
488 Safefree (coro); 1160ready (SV *self)
1161 PROTOTYPE: $
1162 CODE:
1163 api_ready (self);
489 1164
1165int
1166nready (...)
1167 PROTOTYPE:
1168 CODE:
1169 RETVAL = coro_nready;
1170 OUTPUT:
1171 RETVAL
490 1172
1173MODULE = Coro::State PACKAGE = Coro::AIO
1174
1175SV *
1176_get_state ()
1177 CODE:
1178{
1179 struct {
1180 int errorno;
1181 int laststype;
1182 int laststatval;
1183 Stat_t statcache;
1184 } data;
1185
1186 data.errorno = errno;
1187 data.laststype = PL_laststype;
1188 data.laststatval = PL_laststatval;
1189 data.statcache = PL_statcache;
1190
1191 RETVAL = newSVpvn ((char *)&data, sizeof data);
1192}
1193 OUTPUT:
1194 RETVAL
1195
1196void
1197_set_state (char *data_)
1198 PROTOTYPE: $
1199 CODE:
1200{
1201 struct {
1202 int errorno;
1203 int laststype;
1204 int laststatval;
1205 Stat_t statcache;
1206 } *data = (void *)data_;
1207
1208 errno = data->errorno;
1209 PL_laststype = data->laststype;
1210 PL_laststatval = data->laststatval;
1211 PL_statcache = data->statcache;
1212}

Diff Legend

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