ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/Coro/Coro/State.xs
(Generate patch)

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

Diff Legend

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