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

Diff Legend

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