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.191 by root, Fri Oct 5 20:47:49 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/* 5.8.8 */
81#ifndef GV_NOTQUAL
82# define GV_NOTQUAL 0
83#endif
84#ifndef newSV
85# define newSV(l) NEWSV(0,l)
86#endif
87
88#if !__i386 && !__x86_64 && !__powerpc && !__m68k && !__alpha && !__mips && !__sparc64
89# undef CORO_STACKGUARD
90#endif
91
92#ifndef CORO_STACKGUARD
93# define CORO_STACKGUARD 0
94#endif
95
96/* prefer perl internal functions over our own? */
97#ifndef CORO_PREFER_PERL_FUNCTIONS
98# define CORO_PREFER_PERL_FUNCTIONS 0
99#endif
100
101/* The next macros try to return the current stack pointer, in an as
102 * portable way as possible. */
103#define dSTACKLEVEL volatile char stacklevel
104#define STACKLEVEL ((void *)&stacklevel)
105
106#define IN_DESTRUCT (PL_main_cv == Nullcv)
107
108#if __GNUC__ >= 3
109# define attribute(x) __attribute__(x)
110# define BARRIER __asm__ __volatile__ ("" : : : "memory")
111#else
112# define attribute(x)
113# define BARRIER
114#endif
115
116#define NOINLINE attribute ((noinline))
117
118#include "CoroAPI.h"
119
120#ifdef USE_ITHREADS
121static perl_mutex coro_mutex;
122# define LOCK do { MUTEX_LOCK (&coro_mutex); } while (0)
123# define UNLOCK do { MUTEX_UNLOCK (&coro_mutex); } while (0)
124#else
125# define LOCK (void)0
126# define UNLOCK (void)0
127#endif
128
129/* helper storage struct for Coro::AIO */
130struct io_state
131{
132 int errorno;
133 I32 laststype;
134 int laststatval;
135 Stat_t statcache;
136};
137
138static size_t coro_stacksize = CORO_STACKSIZE;
139static struct CoroAPI coroapi;
140static AV *main_mainstack; /* used to differentiate between $main and others */
141static JMPENV *main_top_env;
142static HV *coro_state_stash, *coro_stash;
143static SV *coro_mortal; /* will be freed after next transfer */
144
145static GV *irsgv; /* $/ */
146static GV *stdoutgv; /* *STDOUT */
147
148/* async_pool helper stuff */
149static SV *sv_pool_rss;
150static SV *sv_pool_size;
151static AV *av_async_pool;
152
153static struct coro_cctx *cctx_first;
154static int cctx_count, cctx_idle;
155
156enum {
157 CC_MAPPED = 0x01,
158 CC_NOREUSE = 0x02, /* throw this away after tracing */
159 CC_TRACE = 0x04,
160 CC_TRACE_SUB = 0x08, /* trace sub calls */
161 CC_TRACE_LINE = 0x10, /* trace each statement */
162 CC_TRACE_ALL = CC_TRACE_SUB | CC_TRACE_LINE,
163};
164
165/* this is a structure representing a c-level coroutine */
166typedef struct coro_cctx {
167 struct coro_cctx *next;
168
169 /* the stack */
170 void *sptr;
171 size_t ssize;
172
173 /* cpu state */
174 void *idle_sp; /* sp of top-level transfer/schedule/cede call */
175 JMPENV *idle_te; /* same as idle_sp, but for top_env, TODO: remove once stable */
176 JMPENV *top_env;
177 coro_context cctx;
178
179#if CORO_USE_VALGRIND
180 int valgrind_id;
181#endif
182 unsigned char flags;
183} coro_cctx;
184
185enum {
186 CF_RUNNING = 0x0001, /* coroutine is running */
187 CF_READY = 0x0002, /* coroutine is ready */
188 CF_NEW = 0x0004, /* has never been switched to */
189 CF_DESTROYED = 0x0008, /* coroutine data has been freed */
190};
191
192/* this is a structure representing a perl-level coroutine */
11struct coro { 193struct coro {
12 U8 dowarn; 194 /* the c coroutine allocated to this perl coroutine, if any */
13 AV *defav; 195 coro_cctx *cctx;
196
197 /* data associated with this coroutine (initial args) */
198 AV *args;
199 int refcnt;
200 int flags; /* CF_ flags */
201
202 /* optionally saved, might be zero */
203 AV *defav; /* @_ */
204 SV *defsv; /* $_ */
205 SV *errsv; /* $@ */
206 SV *deffh; /* default filehandle */
207 SV *irssv; /* $/ */
208 SV *irssv_sv; /* real $/ cache */
14 209
15 PERL_SI *curstackinfo; 210#define VAR(name,type) type name;
16 AV *curstack; 211# include "state.h"
17 AV *mainstack; 212#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 213
41 AV *args; 214 /* statistics */
215 int usecount; /* number of transfers to this coro */
216
217 /* coro process data */
218 int prio;
219 //SV *throw;
220
221 /* async_pool */
222 SV *saved_deffh;
223
224 /* linked list */
225 struct coro *next, *prev;
226 HV *hv; /* the perl hash associated with this coro, if any */
42}; 227};
43 228
44typedef struct coro *Coro__State; 229typedef struct coro *Coro__State;
45typedef struct coro *Coro__State_or_hashref; 230typedef struct coro *Coro__State_or_hashref;
46 231
47static HV *padlist_cache; 232/** Coro ********************************************************************/
48 233
49/* mostly copied from op.c:cv_clone2 */ 234#define PRIO_MAX 3
50STATIC AV * 235#define PRIO_HIGH 1
51clone_padlist (AV *protopadlist) 236#define PRIO_NORMAL 0
237#define PRIO_LOW -1
238#define PRIO_IDLE -3
239#define PRIO_MIN -4
240
241/* for Coro.pm */
242static SV *coro_current;
243static AV *coro_ready [PRIO_MAX-PRIO_MIN+1];
244static int coro_nready;
245static struct coro *coro_first;
246
247/** lowlevel stuff **********************************************************/
248
249static AV *
250coro_clone_padlist (pTHX_ CV *cv)
52{ 251{
53 AV *av; 252 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; 253 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 254
72 newpadlist = newAV (); 255 newpadlist = newAV ();
73 AvREAL_off (newpadlist); 256 AvREAL_off (newpadlist);
74 av_store (newpadlist, 0, (SV *) newpad_name); 257#if PERL_VERSION_ATLEAST (5,9,0)
258 Perl_pad_push (aTHX_ padlist, AvFILLp (padlist) + 1);
259#else
260 Perl_pad_push (aTHX_ padlist, AvFILLp (padlist) + 1, 1);
261#endif
262 newpad = (AV *)AvARRAY (padlist)[AvFILLp (padlist)];
263 --AvFILLp (padlist);
264
265 av_store (newpadlist, 0, SvREFCNT_inc (*av_fetch (padlist, 0, FALSE)));
75 av_store (newpadlist, 1, (SV *) newpad); 266 av_store (newpadlist, 1, (SV *)newpad);
76 267
77 av = newAV (); /* will be @_ */ 268 return newpadlist;
78 av_extend (av, 0); 269}
79 av_store (newpad, 0, (SV *) av);
80 AvFLAGS (av) = AVf_REIFY;
81 270
82 for (ix = fpad; ix > 0; ix--) 271static void
272free_padlist (pTHX_ AV *padlist)
273{
274 /* may be during global destruction */
275 if (SvREFCNT (padlist))
83 { 276 {
84 SV *namesv = (ix <= fname) ? pname[ix] : Nullsv; 277 I32 i = AvFILLp (padlist);
85 if (namesv && namesv != &PL_sv_undef) 278 while (i >= 0)
86 { 279 {
87 char *name = SvPVX (namesv); /* XXX */ 280 SV **svp = av_fetch (padlist, i--, FALSE);
88 if (SvFLAGS (namesv) & SVf_FAKE || *name == '&') 281 if (svp)
89 { /* lexical from outside? */
90 npad[ix] = SvREFCNT_inc (ppad[ix]);
91 } 282 {
92 else
93 { /* our own lexical */
94 SV *sv; 283 SV *sv;
95 if (*name == '&') 284 while (&PL_sv_undef != (sv = av_pop ((AV *)*svp)))
96 sv = SvREFCNT_inc (ppad[ix]); 285 SvREFCNT_dec (sv);
97 else if (*name == '@') 286
98 sv = (SV *) newAV (); 287 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 } 288 }
107 } 289 }
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 290
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); 291 SvREFCNT_dec ((SV*)padlist);
292 }
293}
294
295static int
296coro_cv_free (pTHX_ SV *sv, MAGIC *mg)
297{
298 AV *padlist;
299 AV *av = (AV *)mg->mg_obj;
300
301 /* casting is fun. */
302 while (&PL_sv_undef != (SV *)(padlist = (AV *)av_pop (av)))
303 free_padlist (aTHX_ padlist);
304
305 SvREFCNT_dec (av);
306
307 return 0;
308}
309
310#define PERL_MAGIC_coro PERL_MAGIC_ext
311
312static MGVTBL vtbl_coro = {0, 0, 0, 0, coro_cv_free};
313
314#define CORO_MAGIC(cv) \
315 SvMAGIC (cv) \
316 ? SvMAGIC (cv)->mg_type == PERL_MAGIC_coro \
317 ? SvMAGIC (cv) \
318 : mg_find ((SV *)cv, PERL_MAGIC_coro) \
319 : 0
320
321static struct coro *
322SvSTATE_ (pTHX_ SV *coro)
323{
324 HV *stash;
325 MAGIC *mg;
326
327 if (SvROK (coro))
328 coro = SvRV (coro);
329
330 if (SvTYPE (coro) != SVt_PVHV)
331 croak ("Coro::State object required");
332
333 stash = SvSTASH (coro);
334 if (stash != coro_stash && stash != coro_state_stash)
335 {
336 /* very slow, but rare, check */
337 if (!sv_derived_from (sv_2mortal (newRV_inc (coro)), "Coro::State"))
338 croak ("Coro::State object required");
339 }
340
341 mg = CORO_MAGIC (coro);
342 return (struct coro *)mg->mg_ptr;
343}
344
345#define SvSTATE(sv) SvSTATE_ (aTHX_ (sv))
346
347/* the next two functions merely cache the padlists */
348static void
349get_padlist (pTHX_ CV *cv)
350{
351 MAGIC *mg = CORO_MAGIC (cv);
352 AV *av;
353
354 if (mg && AvFILLp ((av = (AV *)mg->mg_obj)) >= 0)
355 CvPADLIST (cv) = (AV *)AvARRAY (av)[AvFILLp (av)--];
356 else
357 {
358#if CORO_PREFER_PERL_FUNCTIONS
359 /* this is probably cleaner, but also slower? */
360 CV *cp = Perl_cv_clone (cv);
361 CvPADLIST (cv) = CvPADLIST (cp);
362 CvPADLIST (cp) = 0;
363 SvREFCNT_dec (cp);
364#else
365 CvPADLIST (cv) = coro_clone_padlist (aTHX_ cv);
366#endif
367 }
368}
369
370static void
371put_padlist (pTHX_ CV *cv)
372{
373 MAGIC *mg = CORO_MAGIC (cv);
374 AV *av;
375
376 if (!mg)
377 {
378 sv_magic ((SV *)cv, 0, PERL_MAGIC_coro, 0, 0);
379 mg = mg_find ((SV *)cv, PERL_MAGIC_coro);
380 mg->mg_virtual = &vtbl_coro;
381 mg->mg_obj = (SV *)newAV ();
382 }
383
384 av = (AV *)mg->mg_obj;
385
386 if (AvFILLp (av) >= AvMAX (av))
387 av_extend (av, AvMAX (av) + 1);
388
389 AvARRAY (av)[++AvFILLp (av)] = (SV *)CvPADLIST (cv);
390}
391
392/** load & save, init *******************************************************/
393
394static void
395load_perl (pTHX_ Coro__State c)
396{
397#define VAR(name,type) PL_ ## name = c->name;
398# include "state.h"
399#undef VAR
400
401 GvSV (PL_defgv) = c->defsv;
402 GvAV (PL_defgv) = c->defav;
403 GvSV (PL_errgv) = c->errsv;
404 GvSV (irsgv) = c->irssv_sv;
405
406 {
407 dSP;
408 CV *cv;
409
410 /* now do the ugly restore mess */
411 while ((cv = (CV *)POPs))
412 {
413 put_padlist (aTHX_ cv); /* mark this padlist as available */
414 CvDEPTH (cv) = PTR2IV (POPs);
415 CvPADLIST (cv) = (AV *)POPs;
416 }
417
418 PUTBACK;
159 } 419 }
160} 420}
161 421
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 422static void
189SAVE(pTHX_ Coro__State c) 423save_perl (pTHX_ Coro__State c)
190{ 424{
191 { 425 {
192 dSP; 426 dSP;
193 I32 cxix = cxstack_ix; 427 I32 cxix = cxstack_ix;
428 PERL_CONTEXT *ccstk = cxstack;
194 PERL_SI *top_si = PL_curstackinfo; 429 PERL_SI *top_si = PL_curstackinfo;
195 PERL_CONTEXT *ccstk = cxstack;
196 430
197 /* 431 /*
198 * the worst thing you can imagine happens first - we have to save 432 * the worst thing you can imagine happens first - we have to save
199 * (and reinitialize) all cv's in the whole callchain :( 433 * (and reinitialize) all cv's in the whole callchain :(
200 */ 434 */
201 435
202 PUSHs (Nullsv); 436 XPUSHs (Nullsv);
203 /* this loop was inspired by pp_caller */ 437 /* this loop was inspired by pp_caller */
204 for (;;) 438 for (;;)
205 { 439 {
206 while (cxix >= 0) 440 while (cxix >= 0)
207 { 441 {
208 PERL_CONTEXT *cx = &ccstk[cxix--]; 442 PERL_CONTEXT *cx = &ccstk[cxix--];
209 443
210 if (CxTYPE(cx) == CXt_SUB) 444 if (CxTYPE (cx) == CXt_SUB || CxTYPE (cx) == CXt_FORMAT)
211 { 445 {
212 CV *cv = cx->blk_sub.cv; 446 CV *cv = cx->blk_sub.cv;
447
213 if (CvDEPTH(cv)) 448 if (CvDEPTH (cv))
214 { 449 {
215#ifdef USE_THREADS
216 XPUSHs ((SV *)CvOWNER(cv));
217#endif
218 EXTEND (SP, 3); 450 EXTEND (SP, 3);
219 PUSHs ((SV *)CvDEPTH(cv));
220 PUSHs ((SV *)CvPADLIST(cv)); 451 PUSHs ((SV *)CvPADLIST (cv));
452 PUSHs (INT2PTR (SV *, CvDEPTH (cv)));
221 PUSHs ((SV *)cv); 453 PUSHs ((SV *)cv);
222 454
223 get_padlist (cv);
224
225 CvDEPTH(cv) = 0; 455 CvDEPTH (cv) = 0;
226#ifdef USE_THREADS 456 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 } 457 }
233 } 458 }
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 } 459 }
241 460
242 if (top_si->si_type == PERLSI_MAIN) 461 if (top_si->si_type == PERLSI_MAIN)
243 break; 462 break;
244 463
245 top_si = top_si->si_prev; 464 top_si = top_si->si_prev;
246 ccstk = top_si->si_cxstack; 465 ccstk = top_si->si_cxstack;
247 cxix = top_si->si_cxix; 466 cxix = top_si->si_cxix;
248 } 467 }
249 468
250 PUTBACK; 469 PUTBACK;
251 } 470 }
252 471
253 c->dowarn = PL_dowarn;
254 c->defav = GvAV (PL_defgv); 472 c->defav = GvAV (PL_defgv);
255 c->curstackinfo = PL_curstackinfo; 473 c->defsv = DEFSV;
256 c->curstack = PL_curstack; 474 c->errsv = ERRSV;
257 c->mainstack = PL_mainstack; 475 c->irssv_sv = GvSV (irsgv);
258 c->stack_sp = PL_stack_sp; 476
259 c->op = PL_op; 477#define VAR(name,type)c->name = PL_ ## name;
260 c->curpad = PL_curpad; 478# include "state.h"
479#undef VAR
480}
481
482/*
483 * allocate various perl stacks. This is an exact copy
484 * of perl.c:init_stacks, except that it uses less memory
485 * on the (sometimes correct) assumption that coroutines do
486 * not usually need a lot of stackspace.
487 */
488#if CORO_PREFER_PERL_FUNCTIONS
489# define coro_init_stacks init_stacks
490#else
491static void
492coro_init_stacks (pTHX)
493{
494 PL_curstackinfo = new_stackinfo(64, 6);
495 PL_curstackinfo->si_type = PERLSI_MAIN;
496 PL_curstack = PL_curstackinfo->si_stack;
497 PL_mainstack = PL_curstack; /* remember in case we switch stacks */
498
499 PL_stack_base = AvARRAY(PL_curstack);
261 c->stack_base = PL_stack_base; 500 PL_stack_sp = PL_stack_base;
262 c->stack_max = PL_stack_max; 501 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 502
282static void 503 New(50,PL_tmps_stack,64,SV*);
283LOAD(pTHX_ Coro__State c) 504 PL_tmps_floor = -1;
284{ 505 PL_tmps_ix = -1;
285 PL_dowarn = c->dowarn; 506 PL_tmps_max = 64;
286 GvAV (PL_defgv) = c->defav; 507
287 PL_curstackinfo = c->curstackinfo; 508 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; 509 PL_markstack_ptr = PL_markstack;
301 PL_markstack_max = c->markstack_max; 510 PL_markstack_max = PL_markstack + 16;
302 PL_scopestack = c->scopestack; 511
303 PL_scopestack_ix = c->scopestack_ix; 512#ifdef SET_MARK_OFFSET
304 PL_scopestack_max = c->scopestack_max; 513 SET_MARK_OFFSET;
305 PL_savestack = c->savestack; 514#endif
306 PL_savestack_ix = c->savestack_ix; 515
307 PL_savestack_max = c->savestack_max; 516 New(54,PL_scopestack,16,I32);
308 PL_retstack = c->retstack; 517 PL_scopestack_ix = 0;
309 PL_retstack_ix = c->retstack_ix; 518 PL_scopestack_max = 16;
310 PL_retstack_max = c->retstack_max; 519
311 PL_curcop = c->curcop; 520 New(54,PL_savestack,64,ANY);
521 PL_savestack_ix = 0;
522 PL_savestack_max = 64;
523
524#if !PERL_VERSION_ATLEAST (5,9,0)
525 New(54,PL_retstack,4,OP*);
526 PL_retstack_ix = 0;
527 PL_retstack_max = 4;
528#endif
529}
530#endif
531
532/*
533 * destroy the stacks, the callchain etc...
534 */
535static void
536coro_destroy_stacks (pTHX)
537{
538 while (PL_curstackinfo->si_next)
539 PL_curstackinfo = PL_curstackinfo->si_next;
540
541 while (PL_curstackinfo)
542 {
543 PERL_SI *p = PL_curstackinfo->si_prev;
544
545 if (!IN_DESTRUCT)
546 SvREFCNT_dec (PL_curstackinfo->si_stack);
547
548 Safefree (PL_curstackinfo->si_cxstack);
549 Safefree (PL_curstackinfo);
550 PL_curstackinfo = p;
551 }
552
553 Safefree (PL_tmps_stack);
554 Safefree (PL_markstack);
555 Safefree (PL_scopestack);
556 Safefree (PL_savestack);
557#if !PERL_VERSION_ATLEAST (5,9,0)
558 Safefree (PL_retstack);
559#endif
560}
561
562static size_t
563coro_rss (pTHX_ struct coro *coro)
564{
565 size_t rss = sizeof (*coro);
566
567 if (coro->mainstack)
568 {
569 if (coro->flags & CF_RUNNING)
570 {
571 #define VAR(name,type)coro->name = PL_ ## name;
572 # include "state.h"
573 #undef VAR
574 }
575
576 rss += sizeof (coro->curstackinfo);
577 rss += sizeof (SV) + sizeof (struct xpvav) + (1 + AvFILL (coro->curstackinfo->si_stack)) * sizeof (SV *);
578 rss += (coro->curstackinfo->si_cxmax + 1) * sizeof (PERL_CONTEXT);
579 rss += sizeof (SV) + sizeof (struct xpvav) + (1 + AvFILL (coro->curstack)) * sizeof (SV *);
580 rss += coro->tmps_max * sizeof (SV *);
581 rss += (coro->markstack_max - coro->markstack_ptr) * sizeof (I32);
582 rss += coro->scopestack_max * sizeof (I32);
583 rss += coro->savestack_max * sizeof (ANY);
584
585#if !PERL_VERSION_ATLEAST (5,9,0)
586 rss += coro->retstack_max * sizeof (OP *);
587#endif
588 }
589
590 return rss;
591}
592
593/** coroutine stack handling ************************************************/
594
595static void
596coro_setup (pTHX_ struct coro *coro)
597{
598 /*
599 * emulate part of the perl startup here.
600 */
601 coro_init_stacks (aTHX);
602
603 PL_runops = RUNOPS_DEFAULT;
604 PL_curcop = &PL_compiling;
605 PL_in_eval = EVAL_NULL;
606 PL_comppad = 0;
607 PL_curpm = 0;
608 PL_localizing = 0;
609 PL_dirty = 0;
610 PL_restartop = 0;
611
612 GvSV (PL_defgv) = newSV (0);
613 GvAV (PL_defgv) = coro->args; coro->args = 0;
614 GvSV (PL_errgv) = newSV (0);
615 GvSV (irsgv) = newSVpvn ("\n", 1); sv_magic (GvSV (irsgv), (SV *)irsgv, PERL_MAGIC_sv, "/", 0);
616 PL_rs = newSVsv (GvSV (irsgv));
617 PL_defoutgv = SvREFCNT_inc (stdoutgv);
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 ("/" , GV_ADD|GV_NOTQUAL, SVt_PV);
391_newprocess(args) 1392 stdoutgv = gv_fetchpv ("STDOUT", GV_ADD|GV_NOTQUAL, SVt_PVIO);
392 SV * args 1393
393 PROTOTYPE: $ 1394 coro_state_stash = gv_stashpv ("Coro::State", TRUE);
1395
1396 newCONSTSUB (coro_state_stash, "CC_TRACE" , newSViv (CC_TRACE));
1397 newCONSTSUB (coro_state_stash, "CC_TRACE_SUB" , newSViv (CC_TRACE_SUB));
1398 newCONSTSUB (coro_state_stash, "CC_TRACE_LINE", newSViv (CC_TRACE_LINE));
1399 newCONSTSUB (coro_state_stash, "CC_TRACE_ALL" , newSViv (CC_TRACE_ALL));
1400
1401 main_mainstack = PL_mainstack;
1402 main_top_env = PL_top_env;
1403
1404 while (main_top_env->je_prev)
1405 main_top_env = main_top_env->je_prev;
1406
1407 coroapi.ver = CORO_API_VERSION;
1408 coroapi.transfer = api_transfer;
1409
1410 assert (("PRIO_NORMAL must be 0", !PRIO_NORMAL));
1411}
1412
1413SV *
1414new (char *klass, ...)
394 CODE: 1415 CODE:
395 Coro__State coro; 1416{
1417 struct coro *coro;
1418 HV *hv;
1419 int i;
396 1420
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); 1421 Newz (0, coro, 1, struct coro);
1422 coro->args = newAV ();
1423 coro->flags = CF_NEW;
401 1424
402 coro->mainstack = 0; /* actual work is done inside transfer */ 1425 if (coro_first) coro_first->prev = coro;
403 coro->args = (AV *)SvREFCNT_inc (SvRV (args)); 1426 coro->next = coro_first;
1427 coro_first = coro;
404 1428
405 RETVAL = coro; 1429 coro->hv = hv = newHV ();
1430 sv_magicext ((SV *)hv, 0, PERL_MAGIC_ext, &coro_state_vtbl, (char *)coro, 0)->mg_flags |= MGf_DUP;
1431 RETVAL = sv_bless (newRV_noinc ((SV *)hv), gv_stashpv (klass, 1));
1432
1433 for (i = 1; i < items; i++)
1434 av_push (coro->args, newSVsv (ST (i)));
1435}
406 OUTPUT: 1436 OUTPUT:
407 RETVAL 1437 RETVAL
408 1438
1439# these not obviously related functions are all rolled into the same xs
1440# function to increase chances that they all will call transfer with the same
1441# stack offset
409void 1442void
410transfer(prev,next) 1443_set_stacklevel (...)
411 Coro::State_or_hashref prev 1444 ALIAS:
412 Coro::State_or_hashref next 1445 Coro::State::transfer = 1
1446 Coro::schedule = 2
1447 Coro::cede = 3
1448 Coro::cede_notself = 4
413 CODE: 1449 CODE:
1450{
1451 struct transfer_args ta;
414 1452
415 if (prev != next) 1453 switch (ix)
416 { 1454 {
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 1455 case 0:
1456 ta.prev = (struct coro *)INT2PTR (coro_cctx *, SvIV (ST (0)));
1457 ta.next = 0;
433 { 1458 break;
434 /*
435 * emulate part of the perl startup here.
436 */
437 UNOP myop;
438 1459
439 init_stacks (); /* from perl.c */ 1460 case 1:
440 PL_op = (OP *)&myop; 1461 if (items != 2)
441 /*PL_curcop = 0;*/ 1462 croak ("Coro::State::transfer (prev,next) expects two arguments, not %d", items);
442 GvAV (PL_defgv) = (AV *)SvREFCNT_inc ((SV *)next->args);
443 1463
444 SPAGAIN; 1464 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 } 1465 break;
1466
1467 case 2:
1468 prepare_schedule (aTHX_ &ta);
1469 break;
1470
1471 case 3:
1472 prepare_cede (aTHX_ &ta);
1473 break;
1474
1475 case 4:
1476 if (!prepare_cede_notself (aTHX_ &ta))
1477 XSRETURN_EMPTY;
1478
1479 break;
463 } 1480 }
464 1481
1482 BARRIER;
1483 TRANSFER (ta);
1484
1485 if (GIMME_V != G_VOID && ta.next != ta.prev)
1486 XSRETURN_YES;
1487}
1488
1489bool
1490_destroy (SV *coro_sv)
1491 CODE:
1492 RETVAL = coro_state_destroy (aTHX_ SvSTATE (coro_sv));
1493 OUTPUT:
1494 RETVAL
1495
465void 1496void
466DESTROY(coro) 1497_exit (code)
467 Coro::State coro 1498 int code
468 CODE: 1499 PROTOTYPE: $
1500 CODE:
1501 _exit (code);
469 1502
1503int
1504cctx_stacksize (int new_stacksize = 0)
1505 CODE:
1506 RETVAL = coro_stacksize;
1507 if (new_stacksize)
1508 coro_stacksize = new_stacksize;
1509 OUTPUT:
1510 RETVAL
1511
1512int
1513cctx_count ()
1514 CODE:
1515 RETVAL = cctx_count;
1516 OUTPUT:
1517 RETVAL
1518
1519int
1520cctx_idle ()
1521 CODE:
1522 RETVAL = cctx_idle;
1523 OUTPUT:
1524 RETVAL
1525
1526void
1527list ()
1528 PPCODE:
1529{
1530 struct coro *coro;
1531 for (coro = coro_first; coro; coro = coro->next)
1532 if (coro->hv)
1533 XPUSHs (sv_2mortal (newRV_inc ((SV *)coro->hv)));
1534}
1535
1536void
1537call (Coro::State coro, SV *coderef)
1538 ALIAS:
1539 eval = 1
1540 CODE:
1541{
470 if (coro->mainstack) 1542 if (coro->mainstack)
471 { 1543 {
472 struct coro temp; 1544 struct coro temp;
1545 Zero (&temp, 1, struct coro);
473 1546
1547 if (!(coro->flags & CF_RUNNING))
1548 {
1549 save_perl (aTHX_ &temp);
1550 load_perl (aTHX_ coro);
1551 }
1552
1553 {
1554 dSP;
1555 ENTER;
1556 SAVETMPS;
1557 PUSHMARK (SP);
474 PUTBACK; 1558 PUTBACK;
475 SAVE(aTHX_ (&temp)); 1559 if (ix)
476 LOAD(aTHX_ coro); 1560 eval_sv (coderef, 0);
477 1561 else
478 destroy_stacks (); 1562 call_sv (coderef, G_KEEPERR | G_EVAL | G_VOID | G_DISCARD);
479 SvREFCNT_dec ((SV *)GvAV (PL_defgv));
480
481 LOAD((&temp));
482 SPAGAIN; 1563 SPAGAIN;
1564 FREETMPS;
1565 LEAVE;
1566 PUTBACK;
1567 }
1568
1569 if (!(coro->flags & CF_RUNNING))
1570 {
1571 save_perl (aTHX_ coro);
1572 load_perl (aTHX_ &temp);
1573 }
483 } 1574 }
1575}
484 1576
1577SV *
1578is_ready (Coro::State coro)
1579 PROTOTYPE: $
1580 ALIAS:
1581 is_ready = CF_READY
1582 is_running = CF_RUNNING
1583 is_new = CF_NEW
1584 is_destroyed = CF_DESTROYED
1585 CODE:
1586 RETVAL = boolSV (coro->flags & ix);
1587 OUTPUT:
1588 RETVAL
1589
1590void
1591api_trace (SV *coro, int flags = CC_TRACE | CC_TRACE_SUB)
1592
1593SV *
1594has_stack (Coro::State coro)
1595 PROTOTYPE: $
1596 CODE:
1597 RETVAL = boolSV (!!coro->cctx);
1598 OUTPUT:
1599 RETVAL
1600
1601int
1602is_traced (Coro::State coro)
1603 PROTOTYPE: $
1604 CODE:
1605 RETVAL = (coro->cctx ? coro->cctx->flags : 0) & CC_TRACE_ALL;
1606 OUTPUT:
1607 RETVAL
1608
1609IV
1610rss (Coro::State coro)
1611 PROTOTYPE: $
1612 ALIAS:
1613 usecount = 1
1614 CODE:
1615 switch (ix)
1616 {
1617 case 0: RETVAL = coro_rss (aTHX_ coro); break;
1618 case 1: RETVAL = coro->usecount; break;
1619 }
1620 OUTPUT:
1621 RETVAL
1622
1623
1624MODULE = Coro::State PACKAGE = Coro
1625
1626BOOT:
1627{
1628 int i;
1629
1630 sv_pool_rss = get_sv ("Coro::POOL_RSS" , TRUE);
1631 sv_pool_size = get_sv ("Coro::POOL_SIZE" , TRUE);
1632 av_async_pool = get_av ("Coro::async_pool", TRUE);
1633
1634 coro_current = get_sv ("Coro::current", FALSE);
1635 SvREADONLY_on (coro_current);
1636
1637 coro_stash = gv_stashpv ("Coro", TRUE);
1638
1639 newCONSTSUB (coro_stash, "PRIO_MAX", newSViv (PRIO_MAX));
1640 newCONSTSUB (coro_stash, "PRIO_HIGH", newSViv (PRIO_HIGH));
1641 newCONSTSUB (coro_stash, "PRIO_NORMAL", newSViv (PRIO_NORMAL));
1642 newCONSTSUB (coro_stash, "PRIO_LOW", newSViv (PRIO_LOW));
1643 newCONSTSUB (coro_stash, "PRIO_IDLE", newSViv (PRIO_IDLE));
1644 newCONSTSUB (coro_stash, "PRIO_MIN", newSViv (PRIO_MIN));
1645
1646 for (i = PRIO_MAX - PRIO_MIN + 1; i--; )
1647 coro_ready[i] = newAV ();
1648
1649 {
1650 SV *sv = perl_get_sv("Coro::API", 1);
1651
1652 coroapi.schedule = api_schedule;
1653 coroapi.cede = api_cede;
1654 coroapi.cede_notself = api_cede_notself;
1655 coroapi.ready = api_ready;
1656 coroapi.is_ready = api_is_ready;
1657 coroapi.nready = &coro_nready;
1658 coroapi.current = coro_current;
1659
1660 GCoroAPI = &coroapi;
1661 sv_setiv (sv, (IV)&coroapi);
1662 SvREADONLY_on (sv);
1663 }
1664}
1665
1666void
1667_set_current (SV *current)
1668 PROTOTYPE: $
1669 CODE:
1670 SvREFCNT_dec (SvRV (coro_current));
1671 SvRV_set (coro_current, SvREFCNT_inc (SvRV (current)));
1672
1673int
1674prio (Coro::State coro, int newprio = 0)
1675 ALIAS:
1676 nice = 1
1677 CODE:
1678{
1679 RETVAL = coro->prio;
1680
1681 if (items > 1)
1682 {
1683 if (ix)
1684 newprio = coro->prio - newprio;
1685
1686 if (newprio < PRIO_MIN) newprio = PRIO_MIN;
1687 if (newprio > PRIO_MAX) newprio = PRIO_MAX;
1688
1689 coro->prio = newprio;
1690 }
1691}
1692 OUTPUT:
1693 RETVAL
1694
1695SV *
1696ready (SV *self)
1697 PROTOTYPE: $
1698 CODE:
1699 RETVAL = boolSV (api_ready (self));
1700 OUTPUT:
1701 RETVAL
1702
1703int
1704nready (...)
1705 PROTOTYPE:
1706 CODE:
1707 RETVAL = coro_nready;
1708 OUTPUT:
1709 RETVAL
1710
1711# for async_pool speedup
1712void
1713_pool_1 (SV *cb)
1714 CODE:
1715{
1716 struct coro *coro = SvSTATE (coro_current);
1717 HV *hv = (HV *)SvRV (coro_current);
1718 AV *defav = GvAV (PL_defgv);
1719 SV *invoke = hv_delete (hv, "_invoke", sizeof ("_invoke") - 1, 0);
1720 AV *invoke_av;
1721 int i, len;
1722
1723 if (!invoke)
1724 croak ("\3terminate\2\n");
1725
485 SvREFCNT_dec (coro->args); 1726 SvREFCNT_dec (coro->saved_deffh);
486 Safefree (coro); 1727 coro->saved_deffh = SvREFCNT_inc ((SV *)PL_defoutgv);
487 1728
1729 hv_store (hv, "desc", sizeof ("desc") - 1,
1730 newSVpvn ("[async_pool]", sizeof ("[async_pool]") - 1), 0);
488 1731
1732 invoke_av = (AV *)SvRV (invoke);
1733 len = av_len (invoke_av);
1734
1735 sv_setsv (cb, AvARRAY (invoke_av)[0]);
1736
1737 if (len > 0)
1738 {
1739 av_fill (defav, len - 1);
1740 for (i = 0; i < len; ++i)
1741 av_store (defav, i, SvREFCNT_inc (AvARRAY (invoke_av)[i + 1]));
1742 }
1743
1744 SvREFCNT_dec (invoke);
1745}
1746
1747void
1748_pool_2 (SV *cb)
1749 CODE:
1750{
1751 struct coro *coro = SvSTATE (coro_current);
1752
1753 sv_setsv (cb, &PL_sv_undef);
1754
1755 SvREFCNT_dec ((SV *)PL_defoutgv); PL_defoutgv = (GV *)coro->saved_deffh;
1756 coro->saved_deffh = 0;
1757
1758 if (coro_rss (aTHX_ coro) > SvIV (sv_pool_rss)
1759 || av_len (av_async_pool) + 1 >= SvIV (sv_pool_size))
1760 croak ("\3terminate\2\n");
1761
1762 av_clear (GvAV (PL_defgv));
1763 hv_store ((HV *)SvRV (coro_current), "desc", sizeof ("desc") - 1,
1764 newSVpvn ("[async_pool idle]", sizeof ("[async_pool idle]") - 1), 0);
1765
1766 coro->prio = 0;
1767
1768 if (coro->cctx && (coro->cctx->flags & CC_TRACE))
1769 api_trace (coro_current, 0);
1770
1771 av_push (av_async_pool, newSVsv (coro_current));
1772}
1773
1774
1775MODULE = Coro::State PACKAGE = Coro::AIO
1776
1777SV *
1778_get_state ()
1779 CODE:
1780{
1781 struct io_state *data;
1782
1783 RETVAL = newSV (sizeof (struct io_state));
1784 data = (struct io_state *)SvPVX (RETVAL);
1785 SvCUR_set (RETVAL, sizeof (struct io_state));
1786 SvPOK_only (RETVAL);
1787
1788 data->errorno = errno;
1789 data->laststype = PL_laststype;
1790 data->laststatval = PL_laststatval;
1791 data->statcache = PL_statcache;
1792}
1793 OUTPUT:
1794 RETVAL
1795
1796void
1797_set_state (char *data_)
1798 PROTOTYPE: $
1799 CODE:
1800{
1801 struct io_state *data = (void *)data_;
1802
1803 errno = data->errorno;
1804 PL_laststype = data->laststype;
1805 PL_laststatval = data->laststatval;
1806 PL_statcache = data->statcache;
1807}
1808

Diff Legend

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