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.6 by root, Tue Jul 17 15:42:28 2001 UTC vs.
Revision 1.181 by root, Wed Oct 3 17:37:33 2007 UTC

1#include "libcoro/coro.c"
2
3#define PERL_NO_GET_CONTEXT
4
1#include "EXTERN.h" 5#include "EXTERN.h"
2#include "perl.h" 6#include "perl.h"
3#include "XSUB.h" 7#include "XSUB.h"
4 8
5#if 0 9#include "patchlevel.h"
6# define CHK(x) (void *)0 10
11#include <stdio.h>
12#include <errno.h>
13#include <assert.h>
14
15#ifdef HAVE_MMAP
16# include <unistd.h>
17# include <sys/mman.h>
18# ifndef MAP_ANONYMOUS
19# ifdef MAP_ANON
20# define MAP_ANONYMOUS MAP_ANON
21# else
22# undef HAVE_MMAP
23# endif
24# endif
25# include <limits.h>
26# ifndef PAGESIZE
27# define PAGESIZE pagesize
28# define BOOT_PAGESIZE pagesize = sysconf (_SC_PAGESIZE)
29static long pagesize;
30# else
31# define BOOT_PAGESIZE (void)0
32# endif
7#else 33#else
8# define CHK(x) if (!(x)) croak("FATAL, CHK: " #x) 34# define PAGESIZE 0
35# define BOOT_PAGESIZE (void)0
36#endif
37
38#if CORO_USE_VALGRIND
39# include <valgrind/valgrind.h>
40# define REGISTER_STACK(cctx,start,end) (cctx)->valgrind_id = VALGRIND_STACK_REGISTER ((start), (end))
41#else
42# define REGISTER_STACK(cctx,start,end)
43#endif
44
45/* the maximum number of idle cctx that will be pooled */
46#define MAX_IDLE_CCTX 8
47
48#define PERL_VERSION_ATLEAST(a,b,c) \
49 (PERL_REVISION > (a) \
50 || (PERL_REVISION == (a) \
51 && (PERL_VERSION > (b) \
52 || (PERL_VERSION == (b) && PERLSUBVERSION >= (c)))))
53
54#if !PERL_VERSION_ATLEAST (5,6,0)
55# ifndef PL_ppaddr
56# define PL_ppaddr ppaddr
9#endif 57# endif
58# ifndef call_sv
59# define call_sv perl_call_sv
60# endif
61# ifndef get_sv
62# define get_sv perl_get_sv
63# endif
64# ifndef get_cv
65# define get_cv perl_get_cv
66# endif
67# ifndef IS_PADGV
68# define IS_PADGV(v) 0
69# endif
70# ifndef IS_PADCONST
71# define IS_PADCONST(v) 0
72# endif
73#endif
10 74
75/* 5.8.7 */
76#ifndef SvRV_set
77# define SvRV_set(s,v) SvRV(s) = (v)
78#endif
79
80#if !__i386 && !__x86_64 && !__powerpc && !__m68k && !__alpha && !__mips && !__sparc64
81# undef CORO_STACKGUARD
82#endif
83
84#ifndef CORO_STACKGUARD
85# define CORO_STACKGUARD 0
86#endif
87
88/* prefer perl internal functions over our own? */
89#ifndef CORO_PREFER_PERL_FUNCTIONS
90# define CORO_PREFER_PERL_FUNCTIONS 0
91#endif
92
93/* The next macros try to return the current stack pointer, in an as
94 * portable way as possible. */
95#define dSTACKLEVEL volatile char stacklevel
96#define STACKLEVEL ((void *)&stacklevel)
97
98#define IN_DESTRUCT (PL_main_cv == Nullcv)
99
100#if __GNUC__ >= 3
101# define attribute(x) __attribute__(x)
102# define BARRIER __asm__ __volatile__ ("" : : : "memory")
103#else
104# define attribute(x)
105# define BARRIER
106#endif
107
108#define NOINLINE attribute ((noinline))
109
110#include "CoroAPI.h"
111
112#ifdef USE_ITHREADS
113static perl_mutex coro_mutex;
114# define LOCK do { MUTEX_LOCK (&coro_mutex); } while (0)
115# define UNLOCK do { MUTEX_UNLOCK (&coro_mutex); } while (0)
116#else
117# define LOCK (void)0
118# define UNLOCK (void)0
119#endif
120
121/* helper storage struct for Coro::AIO */
122struct io_state
123{
124 int errorno;
125 I32 laststype;
126 int laststatval;
127 Stat_t statcache;
128};
129
130static size_t coro_stacksize = CORO_STACKSIZE;
131static struct CoroAPI coroapi;
132static AV *main_mainstack; /* used to differentiate between $main and others */
133static JMPENV *main_top_env;
134static HV *coro_state_stash, *coro_stash;
135static SV *coro_mortal; /* will be freed after next transfer */
136
137static GV *irsgv; /* $/ */
138
139/* async_pool helper stuff */
140static SV *sv_pool_rss;
141static SV *sv_pool_size;
142static AV *av_async_pool;
143
144static struct coro_cctx *cctx_first;
145static int cctx_count, cctx_idle;
146
147enum {
148 CC_MAPPED = 0x01,
149 CC_NOREUSE = 0x02, /* throw this away after tracing */
150 CC_TRACE = 0x04,
151 CC_TRACE_SUB = 0x08, /* trace sub calls */
152 CC_TRACE_LINE = 0x10, /* trace each statement */
153 CC_TRACE_ALL = CC_TRACE_SUB | CC_TRACE_LINE,
154};
155
156/* this is a structure representing a c-level coroutine */
157typedef struct coro_cctx {
158 struct coro_cctx *next;
159
160 /* the stack */
161 void *sptr;
162 size_t ssize;
163
164 /* cpu state */
165 void *idle_sp; /* sp of top-level transfer/schedule/cede call */
166 JMPENV *idle_te; /* same as idle_sp, but for top_env, TODO: remove once stable */
167 JMPENV *top_env;
168 coro_context cctx;
169
170#if CORO_USE_VALGRIND
171 int valgrind_id;
172#endif
173 unsigned char flags;
174} coro_cctx;
175
176enum {
177 CF_RUNNING = 0x0001, /* coroutine is running */
178 CF_READY = 0x0002, /* coroutine is ready */
179 CF_NEW = 0x0004, /* has never been switched to */
180 CF_DESTROYED = 0x0008, /* coroutine data has been freed */
181};
182
183/* this is a structure representing a perl-level coroutine */
11struct coro { 184struct coro {
12 U8 dowarn; 185 /* the c coroutine allocated to this perl coroutine, if any */
13 AV *defav; 186 coro_cctx *cctx;
187
188 /* data associated with this coroutine (initial args) */
189 AV *args;
190 int refcnt;
191 int flags; /* CF_ flags */
192
193 /* optionally saved, might be zero */
194 AV *defav; /* @_ */
195 SV *defsv; /* $_ */
196 SV *errsv; /* $@ */
197 GV *deffh; /* default filehandle */
198 SV *irssv; /* $/ */
199 SV *irssv_sv; /* real $/ cache */
14 200
15 PERL_SI *curstackinfo; 201#define VAR(name,type) type name;
16 AV *curstack; 202# include "state.h"
17 AV *mainstack; 203#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 204
41 AV *args; 205 /* statistics */
206 int usecount; /* number of transfers to this coro */
207
208 /* coro process data */
209 int prio;
210 //SV *throw;
211
212 /* async_pool */
213 GV *defoutgv;
214
215 /* linked list */
216 struct coro *next, *prev;
217 HV *hv; /* the perl hash associated with this coro, if any */
42}; 218};
43 219
44typedef struct coro *Coro__State; 220typedef struct coro *Coro__State;
45typedef struct coro *Coro__State_or_hashref; 221typedef struct coro *Coro__State_or_hashref;
46 222
47static HV *padlist_cache; 223/** Coro ********************************************************************/
48 224
49/* mostly copied from op.c:cv_clone2 */ 225#define PRIO_MAX 3
50STATIC AV * 226#define PRIO_HIGH 1
51clone_padlist (AV *protopadlist) 227#define PRIO_NORMAL 0
228#define PRIO_LOW -1
229#define PRIO_IDLE -3
230#define PRIO_MIN -4
231
232/* for Coro.pm */
233static SV *coro_current;
234static AV *coro_ready [PRIO_MAX-PRIO_MIN+1];
235static int coro_nready;
236static struct coro *coro_first;
237
238/** lowlevel stuff **********************************************************/
239
240static AV *
241coro_clone_padlist (pTHX_ CV *cv)
52{ 242{
53 AV *av; 243 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; 244 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 245
72 newpadlist = newAV (); 246 newpadlist = newAV ();
73 AvREAL_off (newpadlist); 247 AvREAL_off (newpadlist);
74 av_store (newpadlist, 0, (SV *) newpad_name); 248#if PERL_VERSION_ATLEAST (5,9,0)
249 Perl_pad_push (aTHX_ padlist, AvFILLp (padlist) + 1);
250#else
251 Perl_pad_push (aTHX_ padlist, AvFILLp (padlist) + 1, 1);
252#endif
253 newpad = (AV *)AvARRAY (padlist)[AvFILLp (padlist)];
254 --AvFILLp (padlist);
255
256 av_store (newpadlist, 0, SvREFCNT_inc (*av_fetch (padlist, 0, FALSE)));
75 av_store (newpadlist, 1, (SV *) newpad); 257 av_store (newpadlist, 1, (SV *)newpad);
76 258
77 av = newAV (); /* will be @_ */ 259 return newpadlist;
78 av_extend (av, 0); 260}
79 av_store (newpad, 0, (SV *) av);
80 AvFLAGS (av) = AVf_REIFY;
81 261
82 for (ix = fpad; ix > 0; ix--) 262static void
263free_padlist (pTHX_ AV *padlist)
264{
265 /* may be during global destruction */
266 if (SvREFCNT (padlist))
83 { 267 {
84 SV *namesv = (ix <= fname) ? pname[ix] : Nullsv; 268 I32 i = AvFILLp (padlist);
85 if (namesv && namesv != &PL_sv_undef) 269 while (i >= 0)
86 { 270 {
87 char *name = SvPVX (namesv); /* XXX */ 271 SV **svp = av_fetch (padlist, i--, FALSE);
88 if (SvFLAGS (namesv) & SVf_FAKE || *name == '&') 272 if (svp)
89 { /* lexical from outside? */
90 npad[ix] = SvREFCNT_inc (ppad[ix]);
91 } 273 {
92 else
93 { /* our own lexical */
94 SV *sv; 274 SV *sv;
95 if (*name == '&') 275 while (&PL_sv_undef != (sv = av_pop ((AV *)*svp)))
96 sv = SvREFCNT_inc (ppad[ix]); 276 SvREFCNT_dec (sv);
97 else if (*name == '@') 277
98 sv = (SV *) newAV (); 278 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 } 279 }
107 } 280 }
108 else if (IS_PADGV (ppad[ix]) || IS_PADCONST (ppad[ix]))
109 {
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 }
119 281
120#if 0 /* NONOTUNDERSTOOD */
121 /* Now that vars are all in place, clone nested closures. */
122
123 for (ix = fpad; ix > 0; ix--) {
124 SV* namesv = (ix <= fname) ? pname[ix] : Nullsv;
125 if (namesv
126 && namesv != &PL_sv_undef
127 && !(SvFLAGS(namesv) & SVf_FAKE)
128 && *SvPVX(namesv) == '&'
129 && CvCLONE(ppad[ix]))
130 {
131 CV *kid = cv_clone((CV*)ppad[ix]);
132 SvREFCNT_dec(ppad[ix]);
133 CvCLONE_on(kid);
134 SvPADMY_on(kid);
135 npad[ix] = (SV*)kid;
136 }
137 }
138#endif
139
140 return newpadlist;
141}
142
143STATIC AV *
144free_padlist (AV *padlist)
145{
146 /* may be during global destruction */
147 if (SvREFCNT(padlist))
148 {
149 I32 i = AvFILLp(padlist);
150 while (i >= 0)
151 {
152 SV **svp = av_fetch(padlist, i--, FALSE);
153 SV *sv = svp ? *svp : Nullsv;
154 if (sv)
155 SvREFCNT_dec(sv);
156 }
157
158 SvREFCNT_dec((SV*)padlist); 282 SvREFCNT_dec ((SV*)padlist);
283 }
284}
285
286static int
287coro_cv_free (pTHX_ SV *sv, MAGIC *mg)
288{
289 AV *padlist;
290 AV *av = (AV *)mg->mg_obj;
291
292 /* casting is fun. */
293 while (&PL_sv_undef != (SV *)(padlist = (AV *)av_pop (av)))
294 free_padlist (aTHX_ padlist);
295
296 SvREFCNT_dec (av);
297
298 return 0;
299}
300
301#define PERL_MAGIC_coro PERL_MAGIC_ext
302
303static MGVTBL vtbl_coro = {0, 0, 0, 0, coro_cv_free};
304
305#define CORO_MAGIC(cv) \
306 SvMAGIC (cv) \
307 ? SvMAGIC (cv)->mg_type == PERL_MAGIC_coro \
308 ? SvMAGIC (cv) \
309 : mg_find ((SV *)cv, PERL_MAGIC_coro) \
310 : 0
311
312static struct coro *
313SvSTATE_ (pTHX_ SV *coro)
314{
315 HV *stash;
316 MAGIC *mg;
317
318 if (SvROK (coro))
319 coro = SvRV (coro);
320
321 if (SvTYPE (coro) != SVt_PVHV)
322 croak ("Coro::State object required");
323
324 stash = SvSTASH (coro);
325 if (stash != coro_stash && stash != coro_state_stash)
326 {
327 /* very slow, but rare, check */
328 if (!sv_derived_from (sv_2mortal (newRV_inc (coro)), "Coro::State"))
329 croak ("Coro::State object required");
330 }
331
332 mg = CORO_MAGIC (coro);
333 return (struct coro *)mg->mg_ptr;
334}
335
336#define SvSTATE(sv) SvSTATE_ (aTHX_ (sv))
337
338/* the next two functions merely cache the padlists */
339static void
340get_padlist (pTHX_ CV *cv)
341{
342 MAGIC *mg = CORO_MAGIC (cv);
343 AV *av;
344
345 if (mg && AvFILLp ((av = (AV *)mg->mg_obj)) >= 0)
346 CvPADLIST (cv) = (AV *)AvARRAY (av)[AvFILLp (av)--];
347 else
348 {
349#if CORO_PREFER_PERL_FUNCTIONS
350 /* this is probably cleaner, but also slower? */
351 CV *cp = Perl_cv_clone (cv);
352 CvPADLIST (cv) = CvPADLIST (cp);
353 CvPADLIST (cp) = 0;
354 SvREFCNT_dec (cp);
355#else
356 CvPADLIST (cv) = coro_clone_padlist (aTHX_ cv);
357#endif
358 }
359}
360
361static void
362put_padlist (pTHX_ CV *cv)
363{
364 MAGIC *mg = CORO_MAGIC (cv);
365 AV *av;
366
367 if (!mg)
368 {
369 sv_magic ((SV *)cv, 0, PERL_MAGIC_coro, 0, 0);
370 mg = mg_find ((SV *)cv, PERL_MAGIC_coro);
371 mg->mg_virtual = &vtbl_coro;
372 mg->mg_obj = (SV *)newAV ();
373 }
374
375 av = (AV *)mg->mg_obj;
376
377 if (AvFILLp (av) >= AvMAX (av))
378 av_extend (av, AvMAX (av) + 1);
379
380 AvARRAY (av)[++AvFILLp (av)] = (SV *)CvPADLIST (cv);
381}
382
383/** load & save, init *******************************************************/
384
385static void
386load_perl (pTHX_ Coro__State c)
387{
388#define VAR(name,type) PL_ ## name = c->name;
389# include "state.h"
390#undef VAR
391
392 GvSV (PL_defgv) = c->defsv;
393 GvAV (PL_defgv) = c->defav;
394 GvSV (PL_errgv) = c->errsv;
395 PL_defoutgv = c->deffh;
396 PL_rs = c->irssv;
397 GvSV (irsgv) = c->irssv_sv;
398
399 {
400 dSP;
401 CV *cv;
402
403 /* now do the ugly restore mess */
404 while ((cv = (CV *)POPs))
405 {
406 put_padlist (aTHX_ cv); /* mark this padlist as available */
407 CvDEPTH (cv) = PTR2IV (POPs);
408 CvPADLIST (cv) = (AV *)POPs;
409 }
410
411 PUTBACK;
159 } 412 }
160} 413}
161 414
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 415static void
189save_state(pTHX_ Coro__State c) 416save_perl (pTHX_ Coro__State c)
190{ 417{
191 { 418 {
192 dSP; 419 dSP;
193 I32 cxix = cxstack_ix; 420 I32 cxix = cxstack_ix;
421 PERL_CONTEXT *ccstk = cxstack;
194 PERL_SI *top_si = PL_curstackinfo; 422 PERL_SI *top_si = PL_curstackinfo;
195 PERL_CONTEXT *ccstk = cxstack;
196 423
197 /* 424 /*
198 * the worst thing you can imagine happens first - we have to save 425 * the worst thing you can imagine happens first - we have to save
199 * (and reinitialize) all cv's in the whole callchain :( 426 * (and reinitialize) all cv's in the whole callchain :(
200 */ 427 */
201 428
202 PUSHs (Nullsv); 429 XPUSHs (Nullsv);
203 /* this loop was inspired by pp_caller */ 430 /* this loop was inspired by pp_caller */
204 for (;;) 431 for (;;)
205 { 432 {
206 while (cxix >= 0) 433 while (cxix >= 0)
207 { 434 {
208 PERL_CONTEXT *cx = &ccstk[cxix--]; 435 PERL_CONTEXT *cx = &ccstk[cxix--];
209 436
210 if (CxTYPE(cx) == CXt_SUB) 437 if (CxTYPE (cx) == CXt_SUB || CxTYPE (cx) == CXt_FORMAT)
211 { 438 {
212 CV *cv = cx->blk_sub.cv; 439 CV *cv = cx->blk_sub.cv;
440
213 if (CvDEPTH(cv)) 441 if (CvDEPTH (cv))
214 { 442 {
215#ifdef USE_THREADS
216 XPUSHs ((SV *)CvOWNER(cv));
217#endif
218 EXTEND (SP, 3); 443 EXTEND (SP, 3);
219 PUSHs ((SV *)CvDEPTH(cv));
220 PUSHs ((SV *)CvPADLIST(cv)); 444 PUSHs ((SV *)CvPADLIST (cv));
445 PUSHs (INT2PTR (SV *, CvDEPTH (cv)));
221 PUSHs ((SV *)cv); 446 PUSHs ((SV *)cv);
222 447
223 get_padlist (cv);
224
225 CvDEPTH(cv) = 0; 448 CvDEPTH (cv) = 0;
226#ifdef USE_THREADS 449 get_padlist (aTHX_ cv);
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 } 450 }
233 } 451 }
234 else if (CxTYPE(cx) == CXt_FORMAT)
235 {
236 /* I never used formats, so how should I know how these are implemented? */
237 /* my bold guess is as a simple, plain sub... */
238 croak ("CXt_FORMAT not yet handled. Don't switch coroutines from within formats");
239 }
240 } 452 }
241 453
242 if (top_si->si_type == PERLSI_MAIN) 454 if (top_si->si_type == PERLSI_MAIN)
243 break; 455 break;
244 456
245 top_si = top_si->si_prev; 457 top_si = top_si->si_prev;
246 ccstk = top_si->si_cxstack; 458 ccstk = top_si->si_cxstack;
247 cxix = top_si->si_cxix; 459 cxix = top_si->si_cxix;
248 } 460 }
249 461
250 PUTBACK; 462 PUTBACK;
251 } 463 }
252 464
253 c->dowarn = PL_dowarn;
254 c->defav = GvAV (PL_defgv); 465 c->defav = GvAV (PL_defgv);
255 c->curstackinfo = PL_curstackinfo; 466 c->defsv = DEFSV;
256 c->curstack = PL_curstack; 467 c->errsv = ERRSV;
257 c->mainstack = PL_mainstack; 468 c->deffh = PL_defoutgv;
258 c->stack_sp = PL_stack_sp; 469 c->irssv = PL_rs;
259 c->op = PL_op; 470 c->irssv_sv = GvSV (irsgv);
260 c->curpad = PL_curpad; 471
472#define VAR(name,type)c->name = PL_ ## name;
473# include "state.h"
474#undef VAR
475}
476
477/*
478 * allocate various perl stacks. This is an exact copy
479 * of perl.c:init_stacks, except that it uses less memory
480 * on the (sometimes correct) assumption that coroutines do
481 * not usually need a lot of stackspace.
482 */
483#if CORO_PREFER_PERL_FUNCTIONS
484# define coro_init_stacks init_stacks
485#else
486static void
487coro_init_stacks (pTHX)
488{
489 PL_curstackinfo = new_stackinfo(64, 6);
490 PL_curstackinfo->si_type = PERLSI_MAIN;
491 PL_curstack = PL_curstackinfo->si_stack;
492 PL_mainstack = PL_curstack; /* remember in case we switch stacks */
493
494 PL_stack_base = AvARRAY(PL_curstack);
261 c->stack_base = PL_stack_base; 495 PL_stack_sp = PL_stack_base;
262 c->stack_max = PL_stack_max; 496 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 497
282#define LOAD(state) do { load_state(aTHX_ state); SPAGAIN; } while (0) 498 New(50,PL_tmps_stack,64,SV*);
283#define SAVE(state) do { PUTBACK; save_state(aTHX_ state); } while (0) 499 PL_tmps_floor = -1;
500 PL_tmps_ix = -1;
501 PL_tmps_max = 64;
284 502
285static void 503 New(54,PL_markstack,16,I32);
286load_state(pTHX_ Coro__State c)
287{
288 PL_dowarn = c->dowarn;
289 GvAV (PL_defgv) = c->defav;
290 PL_curstackinfo = c->curstackinfo;
291 PL_curstack = c->curstack;
292 PL_mainstack = c->mainstack;
293 PL_stack_sp = c->stack_sp;
294 PL_op = c->op;
295 PL_curpad = c->curpad;
296 PL_stack_base = c->stack_base;
297 PL_stack_max = c->stack_max;
298 PL_tmps_stack = c->tmps_stack;
299 PL_tmps_floor = c->tmps_floor;
300 PL_tmps_ix = c->tmps_ix;
301 PL_tmps_max = c->tmps_max;
302 PL_markstack = c->markstack;
303 PL_markstack_ptr = c->markstack_ptr; 504 PL_markstack_ptr = PL_markstack;
304 PL_markstack_max = c->markstack_max; 505 PL_markstack_max = PL_markstack + 16;
305 PL_scopestack = c->scopestack; 506
306 PL_scopestack_ix = c->scopestack_ix; 507#ifdef SET_MARK_OFFSET
307 PL_scopestack_max = c->scopestack_max; 508 SET_MARK_OFFSET;
308 PL_savestack = c->savestack; 509#endif
309 PL_savestack_ix = c->savestack_ix; 510
310 PL_savestack_max = c->savestack_max; 511 New(54,PL_scopestack,16,I32);
311 PL_retstack = c->retstack; 512 PL_scopestack_ix = 0;
312 PL_retstack_ix = c->retstack_ix; 513 PL_scopestack_max = 16;
313 PL_retstack_max = c->retstack_max; 514
314 PL_curcop = c->curcop; 515 New(54,PL_savestack,64,ANY);
516 PL_savestack_ix = 0;
517 PL_savestack_max = 64;
518
519#if !PERL_VERSION_ATLEAST (5,9,0)
520 New(54,PL_retstack,4,OP*);
521 PL_retstack_ix = 0;
522 PL_retstack_max = 4;
523#endif
524}
525#endif
526
527/*
528 * destroy the stacks, the callchain etc...
529 */
530static void
531coro_destroy_stacks (pTHX)
532{
533 while (PL_curstackinfo->si_next)
534 PL_curstackinfo = PL_curstackinfo->si_next;
535
536 while (PL_curstackinfo)
537 {
538 PERL_SI *p = PL_curstackinfo->si_prev;
539
540 if (!IN_DESTRUCT)
541 SvREFCNT_dec (PL_curstackinfo->si_stack);
542
543 Safefree (PL_curstackinfo->si_cxstack);
544 Safefree (PL_curstackinfo);
545 PL_curstackinfo = p;
546 }
547
548 Safefree (PL_tmps_stack);
549 Safefree (PL_markstack);
550 Safefree (PL_scopestack);
551 Safefree (PL_savestack);
552#if !PERL_VERSION_ATLEAST (5,9,0)
553 Safefree (PL_retstack);
554#endif
555}
556
557static size_t
558coro_rss (pTHX_ struct coro *coro)
559{
560 size_t rss = sizeof (coro);
561
562 if (coro->mainstack)
563 {
564 if (coro->flags & CF_RUNNING)
565 {
566 #define VAR(name,type)coro->name = PL_ ## name;
567 # include "state.h"
568 #undef VAR
569 }
570
571 rss += sizeof (coro->curstackinfo);
572 rss += sizeof (struct xpvav) + (1 + AvFILL (coro->curstackinfo->si_stack)) * sizeof (SV *);
573 rss += (coro->curstackinfo->si_cxmax + 1) * sizeof (PERL_CONTEXT);
574 rss += sizeof (struct xpvav) + (1 + AvFILL (coro->curstack)) * sizeof (SV *);
575 rss += coro->tmps_max * sizeof (SV *);
576 rss += (coro->markstack_max - coro->markstack_ptr) * sizeof (I32);
577 rss += coro->scopestack_max * sizeof (I32);
578 rss += coro->savestack_max * sizeof (ANY);
579
580#if !PERL_VERSION_ATLEAST (5,9,0)
581 rss += coro->retstack_max * sizeof (OP *);
582#endif
583 }
584
585 return rss;
586}
587
588/** coroutine stack handling ************************************************/
589
590static void
591coro_setup (pTHX_ struct coro *coro)
592{
593 /*
594 * emulate part of the perl startup here.
595 */
596 coro_init_stacks (aTHX);
597
598 PL_runops = RUNOPS_DEFAULT;
599 PL_curcop = &PL_compiling;
600 PL_in_eval = EVAL_NULL;
601 PL_comppad = 0;
602 PL_curpm = 0;
603 PL_localizing = 0;
604 PL_dirty = 0;
605 PL_restartop = 0;
606
607 GvSV (PL_defgv) = NEWSV (0, 0);
608 GvAV (PL_defgv) = coro->args; coro->args = 0;
609 GvSV (PL_errgv) = NEWSV (0, 0);
610 GvSV (irsgv) = newSVpvn ("\n", 1); sv_magic (GvSV (irsgv), (SV *)irsgv, PERL_MAGIC_sv, "/", 0);
611 PL_rs = newSVsv (GvSV (irsgv));
612
613 {
614 IO *io = newIO ();
615 PL_defoutgv = newGVgen ("Coro");
616 GvIOp(PL_defoutgv) = io;
617 IoTYPE (io) = IoTYPE_WRONLY;
618 IoOFP (io) = IoIFP (io) = PerlIO_stdout ();
619 IoFLAGS (io) |= IOf_FLUSH;
620 }
315 621
316 { 622 {
317 dSP; 623 dSP;
318 CV *cv; 624 LOGOP myop;
319 625
320 /* now do the ugly restore mess */ 626 Zero (&myop, 1, LOGOP);
321 while ((cv = (CV *)POPs)) 627 myop.op_next = Nullop;
322 { 628 myop.op_flags = OPf_WANT_VOID;
323 AV *padlist = (AV *)POPs;
324 629
325 put_padlist (cv); 630 PUSHMARK (SP);
326 CvPADLIST(cv) = padlist; 631 XPUSHs (av_shift (GvAV (PL_defgv)));
327 CvDEPTH(cv) = (I32)POPs;
328
329#ifdef USE_THREADS
330 CvOWNER(cv) = (struct perl_thread *)POPs;
331 error does not work either
332#endif
333 }
334
335 PUTBACK; 632 PUTBACK;
633 PL_op = (OP *)&myop;
634 PL_op = PL_ppaddr[OP_ENTERSUB](aTHX);
635 SPAGAIN;
336 } 636 }
337}
338 637
339/* this is an EXACT copy of S_nuke_stacks in perl.c, which is unfortunately static */ 638 ENTER; /* necessary e.g. for dounwind */
340STATIC void 639}
341destroy_stacks(pTHX) 640
641static void
642coro_destroy (pTHX_ struct coro *coro)
342{ 643{
343 /* die does this while calling POPSTACK, but I just don't see why. */ 644 if (!IN_DESTRUCT)
344 /* OTOH, die does not have a memleak, but we do... */ 645 {
646 /* restore all saved variables and stuff */
647 LEAVE_SCOPE (0);
648 assert (PL_tmps_floor == -1);
649
650 /* free all temporaries */
651 FREETMPS;
652 assert (PL_tmps_ix == -1);
653
654 /* unwind all extra stacks */
655 POPSTACK_TO (PL_mainstack);
656
657 /* unwind main stack */
345 dounwind(-1); 658 dounwind (-1);
346
347 /* is this ugly, I ask? */
348 while (PL_scopestack_ix)
349 LEAVE;
350
351 while (PL_curstackinfo->si_next)
352 PL_curstackinfo = PL_curstackinfo->si_next;
353
354 while (PL_curstackinfo)
355 { 659 }
356 PERL_SI *p = PL_curstackinfo->si_prev;
357 660
358 SvREFCNT_dec(PL_curstackinfo->si_stack); 661 SvREFCNT_dec (GvSV (PL_defgv));
359 Safefree(PL_curstackinfo->si_cxstack); 662 SvREFCNT_dec (GvAV (PL_defgv));
360 Safefree(PL_curstackinfo); 663 SvREFCNT_dec (GvSV (PL_errgv));
361 PL_curstackinfo = p; 664 SvREFCNT_dec (PL_defoutgv);
665 SvREFCNT_dec (PL_rs);
666 SvREFCNT_dec (GvSV (irsgv));
667
668 SvREFCNT_dec (coro->defoutgv);
669 //SvREFCNT_dec (coro->throw);
670
671 coro_destroy_stacks (aTHX);
672}
673
674static void
675free_coro_mortal (pTHX)
676{
677 if (coro_mortal)
678 {
679 SvREFCNT_dec (coro_mortal);
680 coro_mortal = 0;
362 } 681 }
682}
363 683
364 if (PL_scopestack_ix != 0) 684static int
365 Perl_warner(aTHX_ WARN_INTERNAL, 685runops_trace (pTHX)
366 "Unbalanced scopes: %ld more ENTERs than LEAVEs\n", 686{
367 (long)PL_scopestack_ix); 687 COP *oldcop = 0;
368 if (PL_savestack_ix != 0) 688 int oldcxix = -2;
369 Perl_warner(aTHX_ WARN_INTERNAL, 689 struct coro *coro = SvSTATE (coro_current); /* trace cctx is tied to specific coro */
370 "Unbalanced saves: %ld more saves than restores\n", 690 coro_cctx *cctx = coro->cctx;
371 (long)PL_savestack_ix); 691
372 if (PL_tmps_floor != -1) 692 while ((PL_op = CALL_FPTR (PL_op->op_ppaddr) (aTHX)))
373 Perl_warner(aTHX_ WARN_INTERNAL,"Unbalanced tmps: %ld more allocs than frees\n", 693 {
374 (long)PL_tmps_floor + 1); 694 PERL_ASYNC_CHECK ();
695
696 if (cctx->flags & CC_TRACE_ALL)
697 {
698 if (PL_op->op_type == OP_LEAVESUB && cctx->flags & CC_TRACE_SUB)
699 {
700 PERL_CONTEXT *cx = &cxstack[cxstack_ix];
701 SV **bot, **top;
702 AV *av = newAV (); /* return values */
703 SV **cb;
704 dSP;
705
706 GV *gv = CvGV (cx->blk_sub.cv);
707 SV *fullname = sv_2mortal (newSV (0));
708 if (isGV (gv))
709 gv_efullname3 (fullname, gv, 0);
710
711 bot = PL_stack_base + cx->blk_oldsp + 1;
712 top = cx->blk_gimme == G_ARRAY ? SP + 1
713 : cx->blk_gimme == G_SCALAR ? bot + 1
714 : bot;
715
716 while (bot < top)
717 av_push (av, SvREFCNT_inc (*bot++));
718
719 PL_runops = RUNOPS_DEFAULT;
720 ENTER;
721 SAVETMPS;
722 EXTEND (SP, 3);
723 PUSHMARK (SP);
724 PUSHs (&PL_sv_no);
725 PUSHs (fullname);
726 PUSHs (sv_2mortal (newRV_noinc ((SV *)av)));
727 PUTBACK;
728 cb = hv_fetch ((HV *)SvRV (coro_current), "_trace_sub_cb", sizeof ("_trace_sub_cb") - 1, 0);
729 if (cb) call_sv (*cb, G_KEEPERR | G_EVAL | G_VOID | G_DISCARD);
730 SPAGAIN;
731 FREETMPS;
732 LEAVE;
733 PL_runops = runops_trace;
734 }
735
736 if (oldcop != PL_curcop)
737 {
738 oldcop = PL_curcop;
739
740 if (PL_curcop != &PL_compiling)
741 {
742 SV **cb;
743
744 if (oldcxix != cxstack_ix && cctx->flags & CC_TRACE_SUB)
745 {
746 PERL_CONTEXT *cx = &cxstack[cxstack_ix];
747
748 if (CxTYPE (cx) == CXt_SUB && oldcxix < cxstack_ix)
749 {
750 runops_proc_t old_runops = PL_runops;
751 dSP;
752 GV *gv = CvGV (cx->blk_sub.cv);
753 SV *fullname = sv_2mortal (newSV (0));
754
755 if (isGV (gv))
756 gv_efullname3 (fullname, gv, 0);
757
758 PL_runops = RUNOPS_DEFAULT;
759 ENTER;
760 SAVETMPS;
761 EXTEND (SP, 3);
762 PUSHMARK (SP);
763 PUSHs (&PL_sv_yes);
764 PUSHs (fullname);
765 PUSHs (cx->blk_sub.hasargs ? sv_2mortal (newRV_inc ((SV *)cx->blk_sub.argarray)) : &PL_sv_undef);
766 PUTBACK;
767 cb = hv_fetch ((HV *)SvRV (coro_current), "_trace_sub_cb", sizeof ("_trace_sub_cb") - 1, 0);
768 if (cb) call_sv (*cb, G_KEEPERR | G_EVAL | G_VOID | G_DISCARD);
769 SPAGAIN;
770 FREETMPS;
771 LEAVE;
772 PL_runops = runops_trace;
773 }
774
775 oldcxix = cxstack_ix;
776 }
777
778 if (cctx->flags & CC_TRACE_LINE)
779 {
780 dSP;
781
782 PL_runops = RUNOPS_DEFAULT;
783 ENTER;
784 SAVETMPS;
785 EXTEND (SP, 3);
786 PL_runops = RUNOPS_DEFAULT;
787 PUSHMARK (SP);
788 PUSHs (sv_2mortal (newSVpv (OutCopFILE (oldcop), 0)));
789 PUSHs (sv_2mortal (newSViv (CopLINE (oldcop))));
790 PUTBACK;
791 cb = hv_fetch ((HV *)SvRV (coro_current), "_trace_line_cb", sizeof ("_trace_line_cb") - 1, 0);
792 if (cb) call_sv (*cb, G_KEEPERR | G_EVAL | G_VOID | G_DISCARD);
793 SPAGAIN;
794 FREETMPS;
795 LEAVE;
796 PL_runops = runops_trace;
797 }
798 }
799 }
800 }
801 }
802
803 TAINT_NOT;
804 return 0;
805}
806
807/* inject a fake call to Coro::State::_cctx_init into the execution */
808/* _cctx_init should be careful, as it could be called at almost any time */
809/* during execution of a perl program */
810static void NOINLINE
811prepare_cctx (pTHX_ coro_cctx *cctx)
812{
813 dSP;
814 LOGOP myop;
815
816 PL_top_env = &PL_start_env;
817
818 if (cctx->flags & CC_TRACE)
819 PL_runops = runops_trace;
820
821 Zero (&myop, 1, LOGOP);
822 myop.op_next = PL_op;
823 myop.op_flags = OPf_WANT_VOID | OPf_STACKED;
824
825 PUSHMARK (SP);
826 EXTEND (SP, 2);
827 PUSHs (sv_2mortal (newSViv (PTR2IV (cctx))));
828 PUSHs ((SV *)get_cv ("Coro::State::_cctx_init", FALSE));
829 PUTBACK;
830 PL_op = (OP *)&myop;
831 PL_op = PL_ppaddr[OP_ENTERSUB](aTHX);
832 SPAGAIN;
833}
834
835/*
836 * this is a _very_ stripped down perl interpreter ;)
837 */
838static void
839coro_run (void *arg)
840{
841 dTHX;
842
843 /* coro_run is the alternative tail of transfer(), so unlock here. */
844 UNLOCK;
845
846 /* we now skip the entersub that lead to transfer() */
847 PL_op = PL_op->op_next;
848
849 /* inject a fake subroutine call to cctx_init */
850 prepare_cctx (aTHX_ (coro_cctx *)arg);
851
852 /* somebody or something will hit me for both perl_run and PL_restartop */
853 PL_restartop = PL_op;
854 perl_run (PL_curinterp);
855
375 /* 856 /*
376 */ 857 * If perl-run returns we assume exit() was being called or the coro
377 Safefree(PL_tmps_stack); 858 * fell off the end, which seems to be the only valid (non-bug)
378 Safefree(PL_markstack); 859 * reason for perl_run to return. We try to exit by jumping to the
379 Safefree(PL_scopestack); 860 * bootstrap-time "top" top_env, as we cannot restore the "main"
380 Safefree(PL_savestack); 861 * coroutine as Coro has no such concept
381 Safefree(PL_retstack); 862 */
863 PL_top_env = main_top_env;
864 JMPENV_JUMP (2); /* I do not feel well about the hardcoded 2 at all */
382} 865}
383 866
384#define SUB_INIT "Coro::State::_newcoro" 867static coro_cctx *
868cctx_new ()
869{
870 coro_cctx *cctx;
871 void *stack_start;
872 size_t stack_size;
385 873
874 ++cctx_count;
875
876 Newz (0, cctx, 1, coro_cctx);
877
878#if HAVE_MMAP
879
880 cctx->ssize = ((coro_stacksize * sizeof (long) + PAGESIZE - 1) / PAGESIZE + CORO_STACKGUARD) * PAGESIZE;
881 /* mmap supposedly does allocate-on-write for us */
882 cctx->sptr = mmap (0, cctx->ssize, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_PRIVATE|MAP_ANONYMOUS, 0, 0);
883
884 if (cctx->sptr != (void *)-1)
885 {
886# if CORO_STACKGUARD
887 mprotect (cctx->sptr, CORO_STACKGUARD * PAGESIZE, PROT_NONE);
888# endif
889 stack_start = CORO_STACKGUARD * PAGESIZE + (char *)cctx->sptr;
890 stack_size = cctx->ssize - CORO_STACKGUARD * PAGESIZE;
891 cctx->flags |= CC_MAPPED;
892 }
893 else
894#endif
895 {
896 cctx->ssize = coro_stacksize * (long)sizeof (long);
897 New (0, cctx->sptr, coro_stacksize, long);
898
899 if (!cctx->sptr)
900 {
901 perror ("FATAL: unable to allocate stack for coroutine");
902 _exit (EXIT_FAILURE);
903 }
904
905 stack_start = cctx->sptr;
906 stack_size = cctx->ssize;
907 }
908
909 REGISTER_STACK (cctx, (char *)stack_start, (char *)stack_start + stack_size);
910 coro_create (&cctx->cctx, coro_run, (void *)cctx, stack_start, stack_size);
911
912 return cctx;
913}
914
915static void
916cctx_destroy (coro_cctx *cctx)
917{
918 if (!cctx)
919 return;
920
921 --cctx_count;
922
923#if CORO_USE_VALGRIND
924 VALGRIND_STACK_DEREGISTER (cctx->valgrind_id);
925#endif
926
927#if HAVE_MMAP
928 if (cctx->flags & CC_MAPPED)
929 munmap (cctx->sptr, cctx->ssize);
930 else
931#endif
932 Safefree (cctx->sptr);
933
934 Safefree (cctx);
935}
936
937static coro_cctx *
938cctx_get (pTHX)
939{
940 while (cctx_first)
941 {
942 coro_cctx *cctx = cctx_first;
943 cctx_first = cctx->next;
944 --cctx_idle;
945
946 if (cctx->ssize >= coro_stacksize && !(cctx->flags & CC_NOREUSE))
947 return cctx;
948
949 cctx_destroy (cctx);
950 }
951
952 return cctx_new ();
953}
954
955static void
956cctx_put (coro_cctx *cctx)
957{
958 /* free another cctx if overlimit */
959 if (cctx_idle >= MAX_IDLE_CCTX)
960 {
961 coro_cctx *first = cctx_first;
962 cctx_first = first->next;
963 --cctx_idle;
964
965 cctx_destroy (first);
966 }
967
968 ++cctx_idle;
969 cctx->next = cctx_first;
970 cctx_first = cctx;
971}
972
973/** coroutine switching *****************************************************/
974
975static void NOINLINE
976transfer_check (pTHX_ struct coro *prev, struct coro *next)
977{
978 if (prev != next)
979 {
980 if (!(prev->flags & (CF_RUNNING | CF_NEW)))
981 croak ("Coro::State::transfer called with non-running/new prev Coro::State, but can only transfer from running or new states");
982
983 if (next->flags & CF_RUNNING)
984 croak ("Coro::State::transfer called with running next Coro::State, but can only transfer to inactive states");
985
986 if (next->flags & CF_DESTROYED)
987 croak ("Coro::State::transfer called with destroyed next Coro::State, but can only transfer to inactive states");
988
989 if (PL_lex_state != LEX_NOTPARSING)
990 croak ("Coro::State::transfer called while parsing, but this is not supported");
991 }
992}
993
994/* always use the TRANSFER macro */
995static void NOINLINE
996transfer (pTHX_ struct coro *prev, struct coro *next)
997{
998 dSTACKLEVEL;
999
1000 /* sometimes transfer is only called to set idle_sp */
1001 if (!next)
1002 {
1003 ((coro_cctx *)prev)->idle_sp = STACKLEVEL;
1004 assert (((coro_cctx *)prev)->idle_te = PL_top_env); /* just for the side-effect when asserts are enabled */
1005 }
1006 else if (prev != next)
1007 {
1008 coro_cctx *prev__cctx;
1009
1010 if (prev->flags & CF_NEW)
1011 {
1012 /* create a new empty context */
1013 Newz (0, prev->cctx, 1, coro_cctx);
1014 prev->flags &= ~CF_NEW;
1015 prev->flags |= CF_RUNNING;
1016 }
1017
1018 prev->flags &= ~CF_RUNNING;
1019 next->flags |= CF_RUNNING;
1020
1021 LOCK;
1022
1023 if (next->flags & CF_NEW)
1024 {
1025 /* need to start coroutine */
1026 next->flags &= ~CF_NEW;
1027 /* first get rid of the old state */
1028 save_perl (aTHX_ prev);
1029 /* setup coroutine call */
1030 coro_setup (aTHX_ next);
1031 }
1032 else
1033 {
1034 /* coroutine already started */
1035 save_perl (aTHX_ prev);
1036 load_perl (aTHX_ next);
1037 }
1038
1039 prev__cctx = prev->cctx;
1040
1041 /* possibly "free" the cctx */
1042 if (prev__cctx->idle_sp == STACKLEVEL && !(prev__cctx->flags & CC_TRACE))
1043 {
1044 /* I assume that STACKLEVEL is a stronger indicator than PL_top_env changes */
1045 assert (("ERROR: current top_env must equal previous top_env", PL_top_env == prev__cctx->idle_te));
1046
1047 prev->cctx = 0;
1048
1049 cctx_put (prev__cctx);
1050 }
1051
1052 ++next->usecount;
1053
1054 if (!next->cctx)
1055 next->cctx = cctx_get (aTHX);
1056
1057 if (prev__cctx != next->cctx)
1058 {
1059 prev__cctx->top_env = PL_top_env;
1060 PL_top_env = next->cctx->top_env;
1061 coro_transfer (&prev__cctx->cctx, &next->cctx->cctx);
1062 }
1063
1064 free_coro_mortal (aTHX);
1065 UNLOCK;
1066 }
1067}
1068
1069struct transfer_args
1070{
1071 struct coro *prev, *next;
1072};
1073
1074#define TRANSFER(ta) transfer (aTHX_ (ta).prev, (ta).next)
1075#define TRANSFER_CHECK(ta) transfer_check (aTHX_ (ta).prev, (ta).next)
1076
1077/** high level stuff ********************************************************/
1078
1079static int
1080coro_state_destroy (pTHX_ struct coro *coro)
1081{
1082 if (coro->flags & CF_DESTROYED)
1083 return 0;
1084
1085 coro->flags |= CF_DESTROYED;
1086
1087 if (coro->flags & CF_READY)
1088 {
1089 /* reduce nready, as destroying a ready coro effectively unreadies it */
1090 /* alternative: look through all ready queues and remove the coro */
1091 LOCK;
1092 --coro_nready;
1093 UNLOCK;
1094 }
1095 else
1096 coro->flags |= CF_READY; /* make sure it is NOT put into the readyqueue */
1097
1098 if (coro->mainstack && coro->mainstack != main_mainstack)
1099 {
1100 struct coro temp;
1101
1102 if (coro->flags & CF_RUNNING)
1103 croak ("FATAL: tried to destroy currently running coroutine");
1104
1105 save_perl (aTHX_ &temp);
1106 load_perl (aTHX_ coro);
1107
1108 coro_destroy (aTHX_ coro);
1109
1110 load_perl (aTHX_ &temp); /* this will get rid of defsv etc.. */
1111
1112 coro->mainstack = 0;
1113 }
1114
1115 cctx_destroy (coro->cctx);
1116 SvREFCNT_dec (coro->args);
1117
1118 if (coro->next) coro->next->prev = coro->prev;
1119 if (coro->prev) coro->prev->next = coro->next;
1120 if (coro == coro_first) coro_first = coro->next;
1121
1122 return 1;
1123}
1124
1125static int
1126coro_state_free (pTHX_ SV *sv, MAGIC *mg)
1127{
1128 struct coro *coro = (struct coro *)mg->mg_ptr;
1129 mg->mg_ptr = 0;
1130
1131 coro->hv = 0;
1132
1133 if (--coro->refcnt < 0)
1134 {
1135 coro_state_destroy (aTHX_ coro);
1136 Safefree (coro);
1137 }
1138
1139 return 0;
1140}
1141
1142static int
1143coro_state_dup (pTHX_ MAGIC *mg, CLONE_PARAMS *params)
1144{
1145 struct coro *coro = (struct coro *)mg->mg_ptr;
1146
1147 ++coro->refcnt;
1148
1149 return 0;
1150}
1151
1152static MGVTBL coro_state_vtbl = {
1153 0, 0, 0, 0,
1154 coro_state_free,
1155 0,
1156#ifdef MGf_DUP
1157 coro_state_dup,
1158#else
1159# define MGf_DUP 0
1160#endif
1161};
1162
1163static void
1164prepare_transfer (pTHX_ struct transfer_args *ta, SV *prev_sv, SV *next_sv)
1165{
1166 ta->prev = SvSTATE (prev_sv);
1167 ta->next = SvSTATE (next_sv);
1168 TRANSFER_CHECK (*ta);
1169}
1170
1171static void
1172api_transfer (SV *prev_sv, SV *next_sv)
1173{
1174 dTHX;
1175 struct transfer_args ta;
1176
1177 prepare_transfer (aTHX_ &ta, prev_sv, next_sv);
1178 TRANSFER (ta);
1179}
1180
1181/** Coro ********************************************************************/
1182
1183static void
1184coro_enq (pTHX_ SV *coro_sv)
1185{
1186 av_push (coro_ready [SvSTATE (coro_sv)->prio - PRIO_MIN], coro_sv);
1187}
1188
1189static SV *
1190coro_deq (pTHX_ int min_prio)
1191{
1192 int prio = PRIO_MAX - PRIO_MIN;
1193
1194 min_prio -= PRIO_MIN;
1195 if (min_prio < 0)
1196 min_prio = 0;
1197
1198 for (prio = PRIO_MAX - PRIO_MIN + 1; --prio >= min_prio; )
1199 if (AvFILLp (coro_ready [prio]) >= 0)
1200 return av_shift (coro_ready [prio]);
1201
1202 return 0;
1203}
1204
1205static int
1206api_ready (SV *coro_sv)
1207{
1208 dTHX;
1209 struct coro *coro;
1210
1211 if (SvROK (coro_sv))
1212 coro_sv = SvRV (coro_sv);
1213
1214 coro = SvSTATE (coro_sv);
1215
1216 if (coro->flags & CF_READY)
1217 return 0;
1218
1219 coro->flags |= CF_READY;
1220
1221 LOCK;
1222 coro_enq (aTHX_ SvREFCNT_inc (coro_sv));
1223 ++coro_nready;
1224 UNLOCK;
1225
1226 return 1;
1227}
1228
1229static int
1230api_is_ready (SV *coro_sv)
1231{
1232 dTHX;
1233 return !!(SvSTATE (coro_sv)->flags & CF_READY);
1234}
1235
1236static void
1237prepare_schedule (pTHX_ struct transfer_args *ta)
1238{
1239 SV *prev_sv, *next_sv;
1240
1241 for (;;)
1242 {
1243 LOCK;
1244 next_sv = coro_deq (aTHX_ PRIO_MIN);
1245
1246 /* nothing to schedule: call the idle handler */
1247 if (!next_sv)
1248 {
1249 dSP;
1250 UNLOCK;
1251
1252 ENTER;
1253 SAVETMPS;
1254
1255 PUSHMARK (SP);
1256 PUTBACK;
1257 call_sv (get_sv ("Coro::idle", FALSE), G_DISCARD);
1258
1259 FREETMPS;
1260 LEAVE;
1261 continue;
1262 }
1263
1264 ta->next = SvSTATE (next_sv);
1265
1266 /* cannot transfer to destroyed coros, skip and look for next */
1267 if (ta->next->flags & CF_DESTROYED)
1268 {
1269 UNLOCK;
1270 SvREFCNT_dec (next_sv);
1271 /* coro_nready is already taken care of by destroy */
1272 continue;
1273 }
1274
1275 --coro_nready;
1276 UNLOCK;
1277 break;
1278 }
1279
1280 /* free this only after the transfer */
1281 prev_sv = SvRV (coro_current);
1282 ta->prev = SvSTATE (prev_sv);
1283 TRANSFER_CHECK (*ta);
1284 assert (ta->next->flags & CF_READY);
1285 ta->next->flags &= ~CF_READY;
1286 SvRV_set (coro_current, next_sv);
1287
1288 LOCK;
1289 free_coro_mortal (aTHX);
1290 coro_mortal = prev_sv;
1291 UNLOCK;
1292}
1293
1294static void
1295prepare_cede (pTHX_ struct transfer_args *ta)
1296{
1297 api_ready (coro_current);
1298 prepare_schedule (aTHX_ ta);
1299}
1300
1301static int
1302prepare_cede_notself (pTHX_ struct transfer_args *ta)
1303{
1304 if (coro_nready)
1305 {
1306 SV *prev = SvRV (coro_current);
1307 prepare_schedule (aTHX_ ta);
1308 api_ready (prev);
1309 return 1;
1310 }
1311 else
1312 return 0;
1313}
1314
1315static void
1316api_schedule (void)
1317{
1318 dTHX;
1319 struct transfer_args ta;
1320
1321 prepare_schedule (aTHX_ &ta);
1322 TRANSFER (ta);
1323}
1324
1325static int
1326api_cede (void)
1327{
1328 dTHX;
1329 struct transfer_args ta;
1330
1331 prepare_cede (aTHX_ &ta);
1332
1333 if (ta.prev != ta.next)
1334 {
1335 TRANSFER (ta);
1336 return 1;
1337 }
1338 else
1339 return 0;
1340}
1341
1342static int
1343api_cede_notself (void)
1344{
1345 dTHX;
1346 struct transfer_args ta;
1347
1348 if (prepare_cede_notself (aTHX_ &ta))
1349 {
1350 TRANSFER (ta);
1351 return 1;
1352 }
1353 else
1354 return 0;
1355}
1356
1357static void
1358api_trace (SV *coro_sv, int flags)
1359{
1360 dTHX;
1361 struct coro *coro = SvSTATE (coro_sv);
1362
1363 if (flags & CC_TRACE)
1364 {
1365 if (!coro->cctx)
1366 coro->cctx = cctx_new ();
1367 else if (!(coro->cctx->flags & CC_TRACE))
1368 croak ("cannot enable tracing on coroutine with custom stack");
1369
1370 coro->cctx->flags |= CC_NOREUSE | (flags & (CC_TRACE | CC_TRACE_ALL));
1371 }
1372 else if (coro->cctx && coro->cctx->flags & CC_TRACE)
1373 {
1374 coro->cctx->flags &= ~(CC_TRACE | CC_TRACE_ALL);
1375
1376 if (coro->flags & CF_RUNNING)
1377 PL_runops = RUNOPS_DEFAULT;
1378 else
1379 coro->runops = RUNOPS_DEFAULT;
1380 }
1381}
1382
386MODULE = Coro::State PACKAGE = Coro::State 1383MODULE = Coro::State PACKAGE = Coro::State PREFIX = api_
387 1384
388PROTOTYPES: ENABLE 1385PROTOTYPES: DISABLE
389 1386
390BOOT: 1387BOOT:
391 if (!padlist_cache) 1388{
392 padlist_cache = newHV (); 1389#ifdef USE_ITHREADS
1390 MUTEX_INIT (&coro_mutex);
1391#endif
1392 BOOT_PAGESIZE;
393 1393
394Coro::State 1394 irsgv = gv_fetchpv ("/", 1, SVt_PV);
395_newprocess(args) 1395
396 SV * args 1396 coro_state_stash = gv_stashpv ("Coro::State", TRUE);
397 PROTOTYPE: $ 1397
1398 newCONSTSUB (coro_state_stash, "CC_TRACE" , newSViv (CC_TRACE));
1399 newCONSTSUB (coro_state_stash, "CC_TRACE_SUB" , newSViv (CC_TRACE_SUB));
1400 newCONSTSUB (coro_state_stash, "CC_TRACE_LINE", newSViv (CC_TRACE_LINE));
1401 newCONSTSUB (coro_state_stash, "CC_TRACE_ALL" , newSViv (CC_TRACE_ALL));
1402
1403 main_mainstack = PL_mainstack;
1404 main_top_env = PL_top_env;
1405
1406 while (main_top_env->je_prev)
1407 main_top_env = main_top_env->je_prev;
1408
1409 coroapi.ver = CORO_API_VERSION;
1410 coroapi.transfer = api_transfer;
1411
1412 assert (("PRIO_NORMAL must be 0", !PRIO_NORMAL));
1413}
1414
1415SV *
1416new (char *klass, ...)
398 CODE: 1417 CODE:
399 Coro__State coro; 1418{
1419 struct coro *coro;
1420 HV *hv;
1421 int i;
400 1422
401 if (!SvROK (args) || SvTYPE (SvRV (args)) != SVt_PVAV)
402 croak ("Coro::State::newprocess expects an arrayref");
403
404 New (0, coro, 1, struct coro); 1423 Newz (0, coro, 1, struct coro);
1424 coro->args = newAV ();
1425 coro->flags = CF_NEW;
405 1426
406 coro->mainstack = 0; /* actual work is done inside transfer */ 1427 if (coro_first) coro_first->prev = coro;
407 coro->args = (AV *)SvREFCNT_inc (SvRV (args)); 1428 coro->next = coro_first;
1429 coro_first = coro;
408 1430
409 RETVAL = coro; 1431 coro->hv = hv = newHV ();
1432 sv_magicext ((SV *)hv, 0, PERL_MAGIC_ext, &coro_state_vtbl, (char *)coro, 0)->mg_flags |= MGf_DUP;
1433 RETVAL = sv_bless (newRV_noinc ((SV *)hv), gv_stashpv (klass, 1));
1434
1435 for (i = 1; i < items; i++)
1436 av_push (coro->args, newSVsv (ST (i)));
1437}
410 OUTPUT: 1438 OUTPUT:
411 RETVAL 1439 RETVAL
412 1440
1441# these not obviously related functions are all rolled into the same xs
1442# function to increase chances that they all will call transfer with the same
1443# stack offset
413void 1444void
414transfer(prev,next) 1445_set_stacklevel (...)
415 Coro::State_or_hashref prev 1446 ALIAS:
416 Coro::State_or_hashref next 1447 Coro::State::transfer = 1
1448 Coro::schedule = 2
1449 Coro::cede = 3
1450 Coro::cede_notself = 4
417 CODE: 1451 CODE:
1452{
1453 struct transfer_args ta;
418 1454
419 if (prev != next) 1455 switch (ix)
420 { 1456 {
421 /*
422 * this could be done in newprocess which would lead to
423 * extremely elegant and fast (just SAVE/LOAD)
424 * code here, but lazy allocation of stacks has also
425 * some virtues and the overhead of the if() is nil.
426 */
427 if (next->mainstack)
428 {
429 SAVE (prev);
430 LOAD (next);
431 /* mark this state as in-use */
432 next->mainstack = 0;
433 next->tmps_ix = -2;
434 }
435 else if (next->tmps_ix == -2)
436 {
437 croak ("tried to transfer to running coroutine");
438 }
439 else 1457 case 0:
1458 ta.prev = (struct coro *)INT2PTR (coro_cctx *, SvIV (ST (0)));
1459 ta.next = 0;
440 { 1460 break;
441 SAVE (prev);
442 1461
443 /* 1462 case 1:
444 * emulate part of the perl startup here. 1463 if (items != 2)
445 */ 1464 croak ("Coro::State::transfer (prev,next) expects two arguments, not %d", items);
446 UNOP myop;
447 1465
448 init_stacks (); /* from perl.c */ 1466 prepare_transfer (aTHX_ &ta, ST (0), ST (1));
449 PL_op = (OP *)&myop;
450 /*PL_curcop = 0;*/
451 GvAV (PL_defgv) = (AV *)SvREFCNT_inc ((SV *)next->args);
452
453 SPAGAIN;
454 Zero(&myop, 1, UNOP);
455 myop.op_next = Nullop;
456 myop.op_flags = OPf_WANT_VOID;
457
458 PUSHMARK(SP);
459 XPUSHs ((SV*)get_cv(SUB_INIT, TRUE));
460 PUTBACK;
461 /*
462 * the next line is slightly wrong, as PL_op->op_next
463 * is actually being executed so we skip the first op.
464 * that doesn't matter, though, since it is only
465 * pp_nextstate and we never return...
466 */
467 PL_op = Perl_pp_entersub(aTHX);
468 SPAGAIN;
469
470 ENTER;
471 } 1467 break;
1468
1469 case 2:
1470 prepare_schedule (aTHX_ &ta);
1471 break;
1472
1473 case 3:
1474 prepare_cede (aTHX_ &ta);
1475 break;
1476
1477 case 4:
1478 if (!prepare_cede_notself (aTHX_ &ta))
1479 XSRETURN_EMPTY;
1480
1481 break;
472 } 1482 }
473 1483
1484 BARRIER;
1485 TRANSFER (ta);
1486
1487 if (GIMME_V != G_VOID && ta.next != ta.prev)
1488 XSRETURN_YES;
1489}
1490
1491bool
1492_destroy (SV *coro_sv)
1493 CODE:
1494 RETVAL = coro_state_destroy (aTHX_ SvSTATE (coro_sv));
1495 OUTPUT:
1496 RETVAL
1497
474void 1498void
475DESTROY(coro) 1499_exit (code)
476 Coro::State coro 1500 int code
477 CODE: 1501 PROTOTYPE: $
1502 CODE:
1503 _exit (code);
478 1504
1505int
1506cctx_stacksize (int new_stacksize = 0)
1507 CODE:
1508 RETVAL = coro_stacksize;
1509 if (new_stacksize)
1510 coro_stacksize = new_stacksize;
1511 OUTPUT:
1512 RETVAL
1513
1514int
1515cctx_count ()
1516 CODE:
1517 RETVAL = cctx_count;
1518 OUTPUT:
1519 RETVAL
1520
1521int
1522cctx_idle ()
1523 CODE:
1524 RETVAL = cctx_idle;
1525 OUTPUT:
1526 RETVAL
1527
1528void
1529list ()
1530 PPCODE:
1531{
1532 struct coro *coro;
1533 for (coro = coro_first; coro; coro = coro->next)
1534 if (coro->hv)
1535 XPUSHs (sv_2mortal (newRV_inc ((SV *)coro->hv)));
1536}
1537
1538void
1539call (Coro::State coro, SV *coderef)
1540 ALIAS:
1541 eval = 1
1542 CODE:
1543{
479 if (coro->mainstack) 1544 if (coro->mainstack)
480 { 1545 {
481 struct coro temp; 1546 struct coro temp;
1547 Zero (&temp, 1, struct coro);
482 1548
483 SAVE(aTHX_ (&temp)); 1549 if (!(coro->flags & CF_RUNNING))
484 LOAD(aTHX_ coro); 1550 {
1551 save_perl (aTHX_ &temp);
1552 load_perl (aTHX_ coro);
1553 }
485 1554
486 destroy_stacks (); 1555 {
487 SvREFCNT_dec ((SV *)GvAV (PL_defgv)); 1556 dSP;
1557 ENTER;
1558 SAVETMPS;
1559 PUSHMARK (SP);
1560 PUTBACK;
1561 if (ix)
1562 eval_sv (coderef, 0);
1563 else
1564 call_sv (coderef, G_KEEPERR | G_EVAL | G_VOID | G_DISCARD);
1565 SPAGAIN;
1566 FREETMPS;
1567 LEAVE;
1568 PUTBACK;
1569 }
488 1570
489 LOAD((&temp)); 1571 if (!(coro->flags & CF_RUNNING))
1572 {
1573 save_perl (aTHX_ coro);
1574 load_perl (aTHX_ &temp);
1575 }
490 } 1576 }
1577}
491 1578
1579SV *
1580is_ready (Coro::State coro)
1581 PROTOTYPE: $
1582 ALIAS:
1583 is_ready = CF_READY
1584 is_running = CF_RUNNING
1585 is_new = CF_NEW
1586 is_destroyed = CF_DESTROYED
1587 CODE:
1588 RETVAL = boolSV (coro->flags & ix);
1589 OUTPUT:
1590 RETVAL
1591
1592void
1593api_trace (SV *coro, int flags = CC_TRACE | CC_TRACE_SUB)
1594
1595SV *
1596has_stack (Coro::State coro)
1597 PROTOTYPE: $
1598 CODE:
1599 RETVAL = boolSV (!!coro->cctx);
1600 OUTPUT:
1601 RETVAL
1602
1603int
1604is_traced (Coro::State coro)
1605 PROTOTYPE: $
1606 CODE:
1607 RETVAL = (coro->cctx ? coro->cctx->flags : 0) & CC_TRACE_ALL;
1608 OUTPUT:
1609 RETVAL
1610
1611IV
1612rss (Coro::State coro)
1613 PROTOTYPE: $
1614 ALIAS:
1615 usecount = 1
1616 CODE:
1617 switch (ix)
1618 {
1619 case 0: RETVAL = coro_rss (aTHX_ coro); break;
1620 case 1: RETVAL = coro->usecount; break;
1621 }
1622 OUTPUT:
1623 RETVAL
1624
1625
1626MODULE = Coro::State PACKAGE = Coro
1627
1628BOOT:
1629{
1630 int i;
1631
1632 sv_pool_rss = get_sv ("Coro::POOL_RSS" , TRUE);
1633 sv_pool_size = get_sv ("Coro::POOL_SIZE" , TRUE);
1634 av_async_pool = get_av ("Coro::async_pool", TRUE);
1635
1636 coro_current = get_sv ("Coro::current", FALSE);
1637 SvREADONLY_on (coro_current);
1638
1639 coro_stash = gv_stashpv ("Coro", TRUE);
1640
1641 newCONSTSUB (coro_stash, "PRIO_MAX", newSViv (PRIO_MAX));
1642 newCONSTSUB (coro_stash, "PRIO_HIGH", newSViv (PRIO_HIGH));
1643 newCONSTSUB (coro_stash, "PRIO_NORMAL", newSViv (PRIO_NORMAL));
1644 newCONSTSUB (coro_stash, "PRIO_LOW", newSViv (PRIO_LOW));
1645 newCONSTSUB (coro_stash, "PRIO_IDLE", newSViv (PRIO_IDLE));
1646 newCONSTSUB (coro_stash, "PRIO_MIN", newSViv (PRIO_MIN));
1647
1648 for (i = PRIO_MAX - PRIO_MIN + 1; i--; )
1649 coro_ready[i] = newAV ();
1650
1651 {
1652 SV *sv = perl_get_sv("Coro::API", 1);
1653
1654 coroapi.schedule = api_schedule;
1655 coroapi.cede = api_cede;
1656 coroapi.cede_notself = api_cede_notself;
1657 coroapi.ready = api_ready;
1658 coroapi.is_ready = api_is_ready;
1659 coroapi.nready = &coro_nready;
1660 coroapi.current = coro_current;
1661
1662 GCoroAPI = &coroapi;
1663 sv_setiv (sv, (IV)&coroapi);
1664 SvREADONLY_on (sv);
1665 }
1666}
1667
1668void
1669_set_current (SV *current)
1670 PROTOTYPE: $
1671 CODE:
1672 SvREFCNT_dec (SvRV (coro_current));
1673 SvRV_set (coro_current, SvREFCNT_inc (SvRV (current)));
1674
1675int
1676prio (Coro::State coro, int newprio = 0)
1677 ALIAS:
1678 nice = 1
1679 CODE:
1680{
1681 RETVAL = coro->prio;
1682
1683 if (items > 1)
1684 {
1685 if (ix)
1686 newprio = coro->prio - newprio;
1687
1688 if (newprio < PRIO_MIN) newprio = PRIO_MIN;
1689 if (newprio > PRIO_MAX) newprio = PRIO_MAX;
1690
1691 coro->prio = newprio;
1692 }
1693}
1694 OUTPUT:
1695 RETVAL
1696
1697SV *
1698ready (SV *self)
1699 PROTOTYPE: $
1700 CODE:
1701 RETVAL = boolSV (api_ready (self));
1702 OUTPUT:
1703 RETVAL
1704
1705int
1706nready (...)
1707 PROTOTYPE:
1708 CODE:
1709 RETVAL = coro_nready;
1710 OUTPUT:
1711 RETVAL
1712
1713# for async_pool speedup
1714void
1715_pool_1 (SV *cb)
1716 CODE:
1717{
1718 struct coro *coro = SvSTATE (coro_current);
1719 HV *hv = (HV *)SvRV (coro_current);
1720 AV *defav = GvAV (PL_defgv);
1721 SV *invoke = hv_delete (hv, "_invoke", sizeof ("_invoke") - 1, 0);
1722 AV *invoke_av;
1723 int i, len;
1724
1725 coro->defoutgv = SvREFCNT_inc (PL_defoutgv);
1726
1727 if (!invoke)
1728 croak ("\3terminate\2\n");
1729
1730 hv_store (hv, "desc", sizeof ("desc") - 1,
1731 newSVpvn ("[async_pool]", sizeof ("[async_pool]") - 1), 0);
1732
1733 invoke_av = (AV *)SvRV (invoke);
1734 len = av_len (invoke_av);
1735
1736 sv_setsv (cb, AvARRAY (invoke_av)[0]);
1737
1738 if (len > 0)
1739 {
1740 av_fill (defav, len - 1);
1741 for (i = 0; i < len; ++i)
1742 av_store (defav, i, SvREFCNT_inc (AvARRAY (invoke_av)[i + 1]));
1743 }
1744
1745
1746
492 SvREFCNT_dec (coro->args); 1747 SvREFCNT_dec (invoke);
493 Safefree (coro); 1748}
494 1749
1750void
1751_pool_2 (SV *cb)
1752 CODE:
1753{
1754 struct coro *coro = SvSTATE (coro_current);
495 1755
1756 sv_setsv (cb, &PL_sv_undef);
1757
1758 SvREFCNT_dec (PL_defoutgv); PL_defoutgv = coro->defoutgv;
1759
1760 if (coro_rss (aTHX_ coro) > SvIV (sv_pool_rss)
1761 || av_len (av_async_pool) + 1 >= SvIV (sv_pool_size))
1762 croak ("\3terminate\2\n");
1763
1764 av_clear (GvAV (PL_defgv));
1765 hv_store ((HV *)SvRV (coro_current), "desc", sizeof ("desc") - 1,
1766 newSVpvn ("[async_pool idle]", sizeof ("[async_pool idle]") - 1), 0);
1767
1768 coro->prio = 0;
1769
1770 if (coro->cctx && (coro->cctx->flags & CC_TRACE))
1771 api_trace (coro_current, 0);
1772
1773 av_push (av_async_pool, newSVsv (coro_current));
1774}
1775
1776
1777MODULE = Coro::State PACKAGE = Coro::AIO
1778
1779SV *
1780_get_state ()
1781 CODE:
1782{
1783 struct io_state *data;
1784
1785 RETVAL = newSV (sizeof (struct io_state));
1786 data = (struct io_state *)SvPVX (RETVAL);
1787 SvCUR_set (RETVAL, sizeof (struct io_state));
1788 SvPOK_only (RETVAL);
1789
1790 data->errorno = errno;
1791 data->laststype = PL_laststype;
1792 data->laststatval = PL_laststatval;
1793 data->statcache = PL_statcache;
1794}
1795 OUTPUT:
1796 RETVAL
1797
1798void
1799_set_state (char *data_)
1800 PROTOTYPE: $
1801 CODE:
1802{
1803 struct io_state *data = (void *)data_;
1804
1805 errno = data->errorno;
1806 PL_laststype = data->laststype;
1807 PL_laststatval = data->laststatval;
1808 PL_statcache = data->statcache;
1809}
1810

Diff Legend

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