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.89 by root, Sat Nov 25 00:40:26 2006 UTC vs.
Revision 1.105 by root, Mon Nov 27 02:01:33 2006 UTC

1#define PERL_NO_GET_CONTEXT
2
3#include "libcoro/coro.c" 1#include "libcoro/coro.c"
4 2
5#include "EXTERN.h" 3#include "EXTERN.h"
6#include "perl.h" 4#include "perl.h"
7#include "XSUB.h" 5#include "XSUB.h"
8 6
9#include "patchlevel.h" 7#include "patchlevel.h"
10 8
11#if PERL_VERSION < 6 9#if USE_VALGRIND
10# include <valgrind/valgrind.h>
11#endif
12
13#define PERL_VERSION_ATLEAST(a,b,c) \
14 (PERL_REVISION > (a) \
15 || (PERL_REVISION == (a) \
16 && (PERL_VERSION > (b) \
17 || (PERL_VERSION == (b) && PERLSUBVERSION >= (c)))))
18
19#if !PERL_VERSION_ATLEAST (5,6,0)
12# ifndef PL_ppaddr 20# ifndef PL_ppaddr
13# define PL_ppaddr ppaddr 21# define PL_ppaddr ppaddr
14# endif 22# endif
15# ifndef call_sv 23# ifndef call_sv
16# define call_sv perl_call_sv 24# define call_sv perl_call_sv
27# ifndef IS_PADCONST 35# ifndef IS_PADCONST
28# define IS_PADCONST(v) 0 36# define IS_PADCONST(v) 0
29# endif 37# endif
30#endif 38#endif
31 39
40#include <stdio.h>
32#include <errno.h> 41#include <errno.h>
33 42
34#if !__i386 && !__x86_64 && !__powerpc && !__m68k && !__alpha && !__mips && !__sparc64 43#if !__i386 && !__x86_64 && !__powerpc && !__m68k && !__alpha && !__mips && !__sparc64
35# undef STACKGUARD 44# undef STACKGUARD
36#endif 45#endif
57# else 66# else
58# define BOOT_PAGESIZE 67# define BOOT_PAGESIZE
59# endif 68# endif
60#endif 69#endif
61 70
62#define SUB_INIT "Coro::State::initialize"
63
64/* The next macro should declare a variable stacklevel that contains and approximation 71/* The next macro should declare a variable stacklevel that contains and approximation
65 * to the current C stack pointer. Its property is that it changes with each call 72 * to the current C stack pointer. Its property is that it changes with each call
66 * and should be unique. */ 73 * and should be unique. */
74#define dSTACKLEVEL int stacklevel
67#define dSTACKLEVEL void *stacklevel = &stacklevel 75#define STACKLEVEL ((void *)&stacklevel)
68 76
69#define IN_DESTRUCT (PL_main_cv == Nullcv) 77#define IN_DESTRUCT (PL_main_cv == Nullcv)
70 78
71#define labs(l) ((l) >= 0 ? (l) : -(l)) 79#if __GNUC__ >= 3
80# define attribute(x) __attribute__(x)
81#else
82# define attribute(x)
83#endif
84
85#define NOINLINE attribute ((noinline))
72 86
73#include "CoroAPI.h" 87#include "CoroAPI.h"
88
89#define TRANSFER_SET_STACKLEVEL 0x8bfbfbfb /* magic cookie */
74 90
75#ifdef USE_ITHREADS 91#ifdef USE_ITHREADS
76static perl_mutex coro_mutex; 92static perl_mutex coro_mutex;
77# define LOCK do { MUTEX_LOCK (&coro_mutex); } while (0) 93# define LOCK do { MUTEX_LOCK (&coro_mutex); } while (0)
78# define UNLOCK do { MUTEX_UNLOCK (&coro_mutex); } while (0) 94# define UNLOCK do { MUTEX_UNLOCK (&coro_mutex); } while (0)
84static struct CoroAPI coroapi; 100static struct CoroAPI coroapi;
85static AV *main_mainstack; /* used to differentiate between $main and others */ 101static AV *main_mainstack; /* used to differentiate between $main and others */
86static HV *coro_state_stash, *coro_stash; 102static HV *coro_state_stash, *coro_stash;
87static SV *coro_mortal; /* will be freed after next transfer */ 103static SV *coro_mortal; /* will be freed after next transfer */
88 104
89/* this is actually not just the c stack but also c registers etc... */ 105/* this is a structure representing a c-level coroutine */
90typedef struct coro_stack { 106typedef struct coro_stack {
91 struct coro_stack *next; 107 struct coro_stack *next;
92 108
93 void *idle_sp; 109 /* the stack */
94 void *sptr; 110 void *sptr;
95 long ssize; /* positive == mmap, otherwise malloc */ 111 long ssize; /* positive == mmap, otherwise malloc */
96 112
97 /* cpu state */ 113 /* cpu state */
114 void *idle_sp; /* sp of top-level transfer/schedule/cede call */
115 JMPENV *top_env;
98 coro_context cctx; 116 coro_context cctx;
117
118#if USE_VALGRIND
119 int valgrind_id;
120#endif
99} coro_stack; 121} coro_stack;
100 122
101static coro_stack *main_stack; 123/* this is a structure representing a perl-level coroutine */
102
103struct coro { 124struct coro {
125 /* the c coroutine allocated to this perl coroutine, if any */
126 coro_stack *stack;
127
128 /* data associated with this coroutine (initial args) */
129 AV *args;
130 int refcnt;
131
104 /* optionally saved, might be zero */ 132 /* optionally saved, might be zero */
105 AV *defav; 133 AV *defav;
106 SV *defsv; 134 SV *defsv;
107 SV *errsv; 135 SV *errsv;
108 136
109 /* saved global state not related to stacks */ 137 /* saved global state not related to stacks */
110 U8 dowarn; 138 U8 dowarn;
111 I32 in_eval; 139 I32 in_eval;
112
113 /* the c stack, if any */
114 coro_stack *stack;
115 140
116 /* the stacks and related info (callchain etc..) */ 141 /* the stacks and related info (callchain etc..) */
117 PERL_SI *curstackinfo; 142 PERL_SI *curstackinfo;
118 AV *curstack; 143 AV *curstack;
119 AV *mainstack; 144 AV *mainstack;
140 OP **retstack; 165 OP **retstack;
141 I32 retstack_ix; 166 I32 retstack_ix;
142 I32 retstack_max; 167 I32 retstack_max;
143 PMOP *curpm; 168 PMOP *curpm;
144 COP *curcop; 169 COP *curcop;
145 JMPENV *top_env;
146 170
147 /* coro process data */ 171 /* coro process data */
148 int prio; 172 int prio;
149
150 /* data associated with this coroutine (initial args) */
151 AV *args;
152 int refcnt;
153}; 173};
154 174
155typedef struct coro *Coro__State; 175typedef struct coro *Coro__State;
156typedef struct coro *Coro__State_or_hashref; 176typedef struct coro *Coro__State_or_hashref;
157 177
158static AV * 178static AV *
159coro_clone_padlist (pTHX_ CV *cv) 179coro_clone_padlist (CV *cv)
160{ 180{
161 AV *padlist = CvPADLIST (cv); 181 AV *padlist = CvPADLIST (cv);
162 AV *newpadlist, *newpad; 182 AV *newpadlist, *newpad;
163 183
164 newpadlist = newAV (); 184 newpadlist = newAV ();
165 AvREAL_off (newpadlist); 185 AvREAL_off (newpadlist);
166#if PERL_VERSION < 9 186#if PERL_VERSION_ATLEAST (5,9,0)
187 Perl_pad_push (aTHX_ padlist, AvFILLp (padlist) + 1);
188#else
167 Perl_pad_push (aTHX_ padlist, AvFILLp (padlist) + 1, 1); 189 Perl_pad_push (aTHX_ padlist, AvFILLp (padlist) + 1, 1);
168#else
169 Perl_pad_push (aTHX_ padlist, AvFILLp (padlist) + 1);
170#endif 190#endif
171 newpad = (AV *)AvARRAY (padlist)[AvFILLp (padlist)]; 191 newpad = (AV *)AvARRAY (padlist)[AvFILLp (padlist)];
172 --AvFILLp (padlist); 192 --AvFILLp (padlist);
173 193
174 av_store (newpadlist, 0, SvREFCNT_inc (*av_fetch (padlist, 0, FALSE))); 194 av_store (newpadlist, 0, SvREFCNT_inc (*av_fetch (padlist, 0, FALSE)));
176 196
177 return newpadlist; 197 return newpadlist;
178} 198}
179 199
180static void 200static void
181free_padlist (pTHX_ AV *padlist) 201free_padlist (AV *padlist)
182{ 202{
183 /* may be during global destruction */ 203 /* may be during global destruction */
184 if (SvREFCNT (padlist)) 204 if (SvREFCNT (padlist))
185 { 205 {
186 I32 i = AvFILLp (padlist); 206 I32 i = AvFILLp (padlist);
207 AV *padlist; 227 AV *padlist;
208 AV *av = (AV *)mg->mg_obj; 228 AV *av = (AV *)mg->mg_obj;
209 229
210 /* casting is fun. */ 230 /* casting is fun. */
211 while (&PL_sv_undef != (SV *)(padlist = (AV *)av_pop (av))) 231 while (&PL_sv_undef != (SV *)(padlist = (AV *)av_pop (av)))
212 free_padlist (aTHX_ padlist); 232 free_padlist (padlist);
213 233
214 SvREFCNT_dec (av); 234 SvREFCNT_dec (av);
215 235
216 return 0; 236 return 0;
217} 237}
220 240
221static MGVTBL vtbl_coro = {0, 0, 0, 0, coro_cv_free}; 241static MGVTBL vtbl_coro = {0, 0, 0, 0, coro_cv_free};
222 242
223/* the next two functions merely cache the padlists */ 243/* the next two functions merely cache the padlists */
224static void 244static void
225get_padlist (pTHX_ CV *cv) 245get_padlist (CV *cv)
226{ 246{
227 MAGIC *mg = mg_find ((SV *)cv, PERL_MAGIC_coro); 247 MAGIC *mg = mg_find ((SV *)cv, PERL_MAGIC_coro);
228 248
229 if (mg && AvFILLp ((AV *)mg->mg_obj) >= 0) 249 if (mg && AvFILLp ((AV *)mg->mg_obj) >= 0)
230 CvPADLIST (cv) = (AV *)av_pop ((AV *)mg->mg_obj); 250 CvPADLIST (cv) = (AV *)av_pop ((AV *)mg->mg_obj);
231 else 251 else
232 { 252 {
233#if 0 253#if 0
234 /* this should work - but it doesn't :( */ 254 /* this is probably cleaner, but also slower? */
235 CV *cp = Perl_cv_clone (aTHX_ cv); 255 CV *cp = Perl_cv_clone (cv);
236 CvPADLIST (cv) = CvPADLIST (cp); 256 CvPADLIST (cv) = CvPADLIST (cp);
237 CvPADLIST (cp) = 0; 257 CvPADLIST (cp) = 0;
238 SvREFCNT_dec (cp); 258 SvREFCNT_dec (cp);
239#else 259#else
240 CvPADLIST (cv) = coro_clone_padlist (aTHX_ cv); 260 CvPADLIST (cv) = coro_clone_padlist (cv);
241#endif 261#endif
242 } 262 }
243} 263}
244 264
245static void 265static void
246put_padlist (pTHX_ CV *cv) 266put_padlist (CV *cv)
247{ 267{
248 MAGIC *mg = mg_find ((SV *)cv, PERL_MAGIC_coro); 268 MAGIC *mg = mg_find ((SV *)cv, PERL_MAGIC_coro);
249 269
250 if (!mg) 270 if (!mg)
251 { 271 {
259} 279}
260 280
261#define SB do { 281#define SB do {
262#define SE } while (0) 282#define SE } while (0)
263 283
264#define LOAD(state) load_state(aTHX_ (state)); 284#define LOAD(state) load_state((state));
265#define SAVE(state,flags) save_state(aTHX_ (state),(flags)); 285#define SAVE(state,flags) save_state((state),(flags));
266 286
267#define REPLACE_SV(sv,val) SB SvREFCNT_dec(sv); (sv) = (val); (val) = 0; SE 287#define REPLACE_SV(sv,val) SB SvREFCNT_dec(sv); (sv) = (val); (val) = 0; SE
268 288
269static void 289static void
270load_state(pTHX_ Coro__State c) 290load_state(Coro__State c)
271{ 291{
272 PL_dowarn = c->dowarn; 292 PL_dowarn = c->dowarn;
273 PL_in_eval = c->in_eval; 293 PL_in_eval = c->in_eval;
274 294
275 PL_curstackinfo = c->curstackinfo; 295 PL_curstackinfo = c->curstackinfo;
293 PL_scopestack_ix = c->scopestack_ix; 313 PL_scopestack_ix = c->scopestack_ix;
294 PL_scopestack_max = c->scopestack_max; 314 PL_scopestack_max = c->scopestack_max;
295 PL_savestack = c->savestack; 315 PL_savestack = c->savestack;
296 PL_savestack_ix = c->savestack_ix; 316 PL_savestack_ix = c->savestack_ix;
297 PL_savestack_max = c->savestack_max; 317 PL_savestack_max = c->savestack_max;
298#if PERL_VERSION < 9 318#if !PERL_VERSION_ATLEAST (5,9,0)
299 PL_retstack = c->retstack; 319 PL_retstack = c->retstack;
300 PL_retstack_ix = c->retstack_ix; 320 PL_retstack_ix = c->retstack_ix;
301 PL_retstack_max = c->retstack_max; 321 PL_retstack_max = c->retstack_max;
302#endif 322#endif
303 PL_curpm = c->curpm; 323 PL_curpm = c->curpm;
304 PL_curcop = c->curcop; 324 PL_curcop = c->curcop;
305 PL_top_env = c->top_env;
306 325
307 if (c->defav) REPLACE_SV (GvAV (PL_defgv), c->defav); 326 if (c->defav) REPLACE_SV (GvAV (PL_defgv), c->defav);
308 if (c->defsv) REPLACE_SV (DEFSV , c->defsv); 327 if (c->defsv) REPLACE_SV (DEFSV , c->defsv);
309 if (c->errsv) REPLACE_SV (ERRSV , c->errsv); 328 if (c->errsv) REPLACE_SV (ERRSV , c->errsv);
310 329
317 { 336 {
318 AV *padlist = (AV *)POPs; 337 AV *padlist = (AV *)POPs;
319 338
320 if (padlist) 339 if (padlist)
321 { 340 {
322 put_padlist (aTHX_ cv); /* mark this padlist as available */ 341 put_padlist (cv); /* mark this padlist as available */
323 CvPADLIST(cv) = padlist; 342 CvPADLIST(cv) = padlist;
324 } 343 }
325 344
326 ++CvDEPTH(cv); 345 ++CvDEPTH(cv);
327 } 346 }
329 PUTBACK; 348 PUTBACK;
330 } 349 }
331} 350}
332 351
333static void 352static void
334save_state(pTHX_ Coro__State c, int flags) 353save_state(Coro__State c, int flags)
335{ 354{
336 { 355 {
337 dSP; 356 dSP;
338 I32 cxix = cxstack_ix; 357 I32 cxix = cxstack_ix;
339 PERL_CONTEXT *ccstk = cxstack; 358 PERL_CONTEXT *ccstk = cxstack;
367 } 386 }
368 387
369 PUSHs ((SV *)CvPADLIST(cv)); 388 PUSHs ((SV *)CvPADLIST(cv));
370 PUSHs ((SV *)cv); 389 PUSHs ((SV *)cv);
371 390
372 get_padlist (aTHX_ cv); 391 get_padlist (cv);
373 } 392 }
374 } 393 }
375#ifdef CXt_FORMAT 394#ifdef CXt_FORMAT
376 else if (CxTYPE(cx) == CXt_FORMAT) 395 else if (CxTYPE(cx) == CXt_FORMAT)
377 { 396 {
421 c->scopestack_ix = PL_scopestack_ix; 440 c->scopestack_ix = PL_scopestack_ix;
422 c->scopestack_max = PL_scopestack_max; 441 c->scopestack_max = PL_scopestack_max;
423 c->savestack = PL_savestack; 442 c->savestack = PL_savestack;
424 c->savestack_ix = PL_savestack_ix; 443 c->savestack_ix = PL_savestack_ix;
425 c->savestack_max = PL_savestack_max; 444 c->savestack_max = PL_savestack_max;
426#if PERL_VERSION < 9 445#if !PERL_VERSION_ATLEAST (5,9,0)
427 c->retstack = PL_retstack; 446 c->retstack = PL_retstack;
428 c->retstack_ix = PL_retstack_ix; 447 c->retstack_ix = PL_retstack_ix;
429 c->retstack_max = PL_retstack_max; 448 c->retstack_max = PL_retstack_max;
430#endif 449#endif
431 c->curpm = PL_curpm; 450 c->curpm = PL_curpm;
432 c->curcop = PL_curcop; 451 c->curcop = PL_curcop;
433 c->top_env = PL_top_env;
434} 452}
435 453
436/* 454/*
437 * allocate various perl stacks. This is an exact copy 455 * allocate various perl stacks. This is an exact copy
438 * of perl.c:init_stacks, except that it uses less memory 456 * of perl.c:init_stacks, except that it uses less memory
439 * on the (sometimes correct) assumption that coroutines do 457 * on the (sometimes correct) assumption that coroutines do
440 * not usually need a lot of stackspace. 458 * not usually need a lot of stackspace.
441 */ 459 */
442static void 460static void
443coro_init_stacks (pTHX) 461coro_init_stacks ()
444{ 462{
445 LOCK;
446
447 PL_curstackinfo = new_stackinfo(96, 1024/sizeof(PERL_CONTEXT) - 1); 463 PL_curstackinfo = new_stackinfo(96, 1024/sizeof(PERL_CONTEXT) - 1);
448 PL_curstackinfo->si_type = PERLSI_MAIN; 464 PL_curstackinfo->si_type = PERLSI_MAIN;
449 PL_curstack = PL_curstackinfo->si_stack; 465 PL_curstack = PL_curstackinfo->si_stack;
450 PL_mainstack = PL_curstack; /* remember in case we switch stacks */ 466 PL_mainstack = PL_curstack; /* remember in case we switch stacks */
451 467
472 488
473 New(54,PL_savestack,96,ANY); 489 New(54,PL_savestack,96,ANY);
474 PL_savestack_ix = 0; 490 PL_savestack_ix = 0;
475 PL_savestack_max = 96; 491 PL_savestack_max = 96;
476 492
477#if PERL_VERSION < 9 493#if !PERL_VERSION_ATLEAST (5,9,0)
478 New(54,PL_retstack,8,OP*); 494 New(54,PL_retstack,8,OP*);
479 PL_retstack_ix = 0; 495 PL_retstack_ix = 0;
480 PL_retstack_max = 8; 496 PL_retstack_max = 8;
481#endif 497#endif
482
483 UNLOCK;
484} 498}
485 499
486/* 500/*
487 * destroy the stacks, the callchain etc... 501 * destroy the stacks, the callchain etc...
488 */ 502 */
489static void 503static void
490destroy_stacks(pTHX) 504coro_destroy_stacks()
491{ 505{
492 if (!IN_DESTRUCT) 506 if (!IN_DESTRUCT)
493 { 507 {
494 /* is this ugly, I ask? */ 508 /* is this ugly, I ask? */
495 LEAVE_SCOPE (0); 509 LEAVE_SCOPE (0);
526 540
527 Safefree (PL_tmps_stack); 541 Safefree (PL_tmps_stack);
528 Safefree (PL_markstack); 542 Safefree (PL_markstack);
529 Safefree (PL_scopestack); 543 Safefree (PL_scopestack);
530 Safefree (PL_savestack); 544 Safefree (PL_savestack);
531#if PERL_VERSION < 9 545#if !PERL_VERSION_ATLEAST (5,9,0)
532 Safefree (PL_retstack); 546 Safefree (PL_retstack);
533#endif 547#endif
534} 548}
535 549
536static void 550static void
537setup_coro (struct coro *coro) 551setup_coro (struct coro *coro)
538{ 552{
539 /* 553 /*
540 * emulate part of the perl startup here. 554 * emulate part of the perl startup here.
541 */ 555 */
542 dTHX;
543 dSP;
544 UNOP myop;
545 SV *sub_init = (SV *)get_cv (SUB_INIT, FALSE);
546 556
547 coro_init_stacks (aTHX); 557 coro_init_stacks ();
558
548 /*PL_curcop = 0;*/ 559 PL_curcop = 0;
549 /*PL_in_eval = PL_in_eval;*/ /* inherit */ 560 PL_in_eval = 0;
561 PL_curpm = 0;
562
563 {
564 dSP;
565 LOGOP myop;
566
567 /* I have no idea why this is needed, but it is */
568 PUSHMARK (SP);
569
550 SvREFCNT_dec (GvAV (PL_defgv)); 570 SvREFCNT_dec (GvAV (PL_defgv));
551 GvAV (PL_defgv) = coro->args; coro->args = 0; 571 GvAV (PL_defgv) = coro->args; coro->args = 0;
552 572
553 SPAGAIN;
554
555 Zero (&myop, 1, UNOP); 573 Zero (&myop, 1, LOGOP);
556 myop.op_next = Nullop; 574 myop.op_next = Nullop;
557 myop.op_flags = OPf_WANT_VOID; 575 myop.op_flags = OPf_WANT_VOID;
558 576
559 PL_op = (OP *)&myop; 577 PL_op = (OP *)&myop;
560 578
561 PUSHMARK(SP); 579 PUSHMARK (SP);
562 XPUSHs (sub_init); 580 XPUSHs ((SV *)get_cv ("Coro::State::coro_init", FALSE));
563 PUTBACK; 581 PUTBACK;
564 PL_op = PL_ppaddr[OP_ENTERSUB](aTHX); 582 PL_op = PL_ppaddr[OP_ENTERSUB](aTHX);
565 SPAGAIN; 583 SPAGAIN;
566 584
567 ENTER; /* necessary e.g. for dounwind */ 585 ENTER; /* necessary e.g. for dounwind */
586 }
568} 587}
569 588
570static void 589static void
571transfer_tail () 590free_coro_mortal ()
572{ 591{
573 if (coro_mortal) 592 if (coro_mortal)
574 { 593 {
575 SvREFCNT_dec (coro_mortal); 594 SvREFCNT_dec (coro_mortal);
576 coro_mortal = 0; 595 coro_mortal = 0;
577 } 596 }
597}
578 598
599static void NOINLINE
600prepare_cctx (coro_stack *cctx)
601{
602 dSP;
603 LOGOP myop;
604
605 Zero (&myop, 1, LOGOP);
606 myop.op_next = PL_op;
607 myop.op_flags = OPf_WANT_VOID;
608
609 sv_setiv (get_sv ("Coro::State::cctx_stack", FALSE), PTR2IV (cctx));
610
611 PUSHMARK (SP);
612 XPUSHs ((SV *)get_cv ("Coro::State::cctx_init", FALSE));
613 PUTBACK;
614 PL_restartop = PL_ppaddr[OP_ENTERSUB](aTHX);
615 SPAGAIN;
616}
617
618static void
619coro_run (void *arg)
620{
621 /* coro_run is the alternative epilogue of transfer() */
579 UNLOCK; 622 UNLOCK;
580}
581 623
582static void
583coro_run (void *arg)
584{
585 /* 624 /*
586 * this is a _very_ stripped down perl interpreter ;) 625 * this is a _very_ stripped down perl interpreter ;)
587 */ 626 */
588 dTHX;
589
590 transfer_tail ();
591
592 PL_top_env = &PL_start_env; 627 PL_top_env = &PL_start_env;
593 PL_restartop = PL_op->op_next; 628 /* inject call to cctx_init */
629 prepare_cctx ((coro_stack *)arg);
630
594 /* somebody will hit me for both perl_run and PL_restart_top */ 631 /* somebody will hit me for both perl_run and PL_restartop */
595 perl_run (aTHX_ PERL_GET_CONTEXT); 632 perl_run (PL_curinterp);
596 633
634 fputs ("FATAL: C coroutine fell over the edge of the world, aborting. Did you call exit in a coroutine?\n", stderr);
597 abort (); 635 abort ();
598} 636}
599 637
600static coro_stack * 638static coro_stack *
601stack_new () 639stack_new ()
604 642
605 New (0, stack, 1, coro_stack); 643 New (0, stack, 1, coro_stack);
606 644
607#if HAVE_MMAP 645#if HAVE_MMAP
608 646
609 stack->ssize = ((STACKSIZE * sizeof (long) + PAGESIZE - 1) / PAGESIZE + STACKGUARD) * PAGESIZE; /* mmap should do allocate-on-write for us */ 647 stack->ssize = ((STACKSIZE * sizeof (long) + PAGESIZE - 1) / PAGESIZE + STACKGUARD) * PAGESIZE;
648 /* mmap suppsedly does allocate-on-write for us */
610 stack->sptr = mmap (0, stack->ssize, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_PRIVATE|MAP_ANONYMOUS, 0, 0); 649 stack->sptr = mmap (0, stack->ssize, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_PRIVATE|MAP_ANONYMOUS, 0, 0);
611 650
612 if (stack->sptr == (void *)-1) 651 if (stack->sptr == (void *)-1)
613 { 652 {
614 fprintf (stderr, "FATAL: unable to mmap stack for coroutine\n"); 653 perror ("FATAL: unable to mmap stack for coroutine");
615 _exit (EXIT_FAILURE); 654 _exit (EXIT_FAILURE);
616 } 655 }
617 656
657# if STACKGUARD
618 mprotect (stack->sptr, STACKGUARD * PAGESIZE, PROT_NONE); 658 mprotect (stack->sptr, STACKGUARD * PAGESIZE, PROT_NONE);
659# endif
619 660
620#else 661#else
621 662
622 stack->ssize = STACKSIZE * (long)sizeof (long); 663 stack->ssize = STACKSIZE * (long)sizeof (long);
623 New (0, stack->sptr, STACKSIZE, long); 664 New (0, stack->sptr, STACKSIZE, long);
624 665
625 if (!stack->sptr) 666 if (!stack->sptr)
626 { 667 {
627 fprintf (stderr, "FATAL: unable to malloc stack for coroutine\n"); 668 perror (stderr, "FATAL: unable to malloc stack for coroutine");
628 _exit (EXIT_FAILURE); 669 _exit (EXIT_FAILURE);
629 } 670 }
630 671
631#endif 672#endif
632 673
674#if USE_VALGRIND
675 stack->valgrind_id = VALGRIND_STACK_REGISTER (
676 STACKGUARD * PAGESIZE + (char *)stack->sptr,
677 stack->ssize + (char *)stack->sptr
678 );
679#endif
680
633 coro_create (&stack->cctx, coro_run, 0, stack->sptr, stack->ssize); 681 coro_create (&stack->cctx, coro_run, (void *)stack, stack->sptr, stack->ssize);
634 682
635 return stack; 683 return stack;
636} 684}
637 685
638static void 686static void
639stack_free (coro_stack *stack) 687stack_free (coro_stack *stack)
640{ 688{
641 if (!stack || stack == main_stack) 689 if (!stack)
642 return; 690 return;
691
692#if USE_VALGRIND
693 VALGRIND_STACK_DEREGISTER (stack->valgrind_id);
694#endif
643 695
644#if HAVE_MMAP 696#if HAVE_MMAP
645 munmap (stack->sptr, stack->ssize); 697 munmap (stack->sptr, stack->ssize);
646#else 698#else
647 Safefree (stack->sptr); 699 Safefree (stack->sptr);
649 701
650 Safefree (stack); 702 Safefree (stack);
651} 703}
652 704
653static coro_stack *stack_first; 705static coro_stack *stack_first;
706static int cctx_count, cctx_idle;
654 707
655static void 708static coro_stack *
656stack_get (struct coro *coro) 709stack_get ()
657{ 710{
711 coro_stack *stack;
712
658 if (stack_first) 713 if (stack_first)
659 { 714 {
715 --cctx_idle;
660 coro->stack = stack_first; 716 stack = stack_first;
661 stack_first = stack_first->next; 717 stack_first = stack->next;
662 } 718 }
663 else 719 else
720 {
721 ++cctx_count;
664 coro->stack = stack_new (); 722 stack = stack_new ();
723 PL_op = PL_op->op_next;
724 }
725
726 return stack;
665} 727}
666 728
667static void 729static void
668stack_put (coro_stack *stack) 730stack_put (coro_stack *stack)
669{ 731{
732 ++cctx_idle;
670 stack->next = stack_first; 733 stack->next = stack_first;
671 stack_first = stack; 734 stack_first = stack;
672} 735}
673 736
674/* never call directly, always through the coro_state_transfer global variable */ 737/* never call directly, always through the coro_state_transfer global variable */
675static void 738static void NOINLINE
676transfer_impl (pTHX_ struct coro *prev, struct coro *next, int flags) 739transfer (struct coro *prev, struct coro *next, int flags)
677{ 740{
678 dSTACKLEVEL; 741 dSTACKLEVEL;
679 742
680 /* sometimes transfer is only called to set idle_sp */ 743 /* sometimes transfer is only called to set idle_sp */
681 if (!prev->stack->idle_sp) 744 if (flags == TRANSFER_SET_STACKLEVEL)
682 prev->stack->idle_sp = stacklevel; 745 ((coro_stack *)prev)->idle_sp = STACKLEVEL;
683
684 LOCK;
685
686 if (prev != next) 746 else if (prev != next)
687 { 747 {
688 coro_stack *prev_stack = prev->stack; 748 coro_stack *prev__stack;
689 749
690 /* possibly "free" the stack */ 750 LOCK;
691 if (prev_stack->idle_sp == stacklevel) 751
752 if (next->mainstack)
692 { 753 {
693 stack_put (prev_stack); 754 /* coroutine already started */
694 prev->stack = 0; 755 SAVE (prev, flags);
756 LOAD (next);
695 } 757 }
696 758 else
697 if (!next->mainstack)
698 { 759 {
760 /* need to start coroutine */
699 /* first get rid of the old state */ 761 /* first get rid of the old state */
700 SAVE (prev, -1); 762 SAVE (prev, -1);
701 /* setup coroutine call */ 763 /* setup coroutine call */
702 setup_coro (next); 764 setup_coro (next);
765 /* need a stack */
703 next->stack = 0; 766 next->stack = 0;
704 } 767 }
705 else 768
769 if (!prev->stack)
770 /* create a new empty context */
771 Newz (0, prev->stack, 1, coro_stack);
772
773 prev__stack = prev->stack;
774
775 /* possibly "free" the stack */
776 if (prev__stack->idle_sp == STACKLEVEL)
706 { 777 {
707 SAVE (prev, flags); 778 stack_put (prev__stack);
708 LOAD (next); 779 prev->stack = 0;
709 } 780 }
710 781
711 if (!next->stack) 782 if (!next->stack)
712 stack_get (next); 783 next->stack = stack_get ();
713 784
714 if (prev_stack != next->stack) 785 if (prev__stack != next->stack)
786 {
787 prev__stack->top_env = PL_top_env;
788 PL_top_env = next->stack->top_env;
715 coro_transfer (&prev_stack->cctx, &next->stack->cctx); 789 coro_transfer (&prev__stack->cctx, &next->stack->cctx);
790 }
791
792 free_coro_mortal ();
793
794 UNLOCK;
716 } 795 }
717
718 transfer_tail ();
719} 796}
720 797
721/* use this function pointer to call the above function */ 798struct transfer_args
722/* this is done to increase chances of the compiler not inlining the call */ 799{
723void (*coro_state_transfer)(pTHX_ struct coro *prev, struct coro *next, int flags) = transfer_impl; 800 struct coro *prev, *next;
801 int flags;
802};
803
804#define TRANSFER(ta) transfer ((ta).prev, (ta).next, (ta).flags)
724 805
725static void 806static void
726coro_state_destroy (struct coro *coro) 807coro_state_destroy (struct coro *coro)
727{ 808{
728 if (coro->refcnt--) 809 if (coro->refcnt--)
730 811
731 if (coro->mainstack && coro->mainstack != main_mainstack) 812 if (coro->mainstack && coro->mainstack != main_mainstack)
732 { 813 {
733 struct coro temp; 814 struct coro temp;
734 815
735 SAVE (aTHX_ (&temp), TRANSFER_SAVE_ALL); 816 SAVE ((&temp), TRANSFER_SAVE_ALL);
736 LOAD (aTHX_ coro); 817 LOAD (coro);
737 818
738 destroy_stacks (aTHX); 819 coro_destroy_stacks ();
739 820
740 LOAD ((&temp)); /* this will get rid of defsv etc.. */ 821 LOAD ((&temp)); /* this will get rid of defsv etc.. */
741 822
742 coro->mainstack = 0; 823 coro->mainstack = 0;
743 } 824 }
746 SvREFCNT_dec (coro->args); 827 SvREFCNT_dec (coro->args);
747 Safefree (coro); 828 Safefree (coro);
748} 829}
749 830
750static int 831static int
751coro_state_clear (SV *sv, MAGIC *mg) 832coro_state_clear (pTHX_ SV *sv, MAGIC *mg)
752{ 833{
753 struct coro *coro = (struct coro *)mg->mg_ptr; 834 struct coro *coro = (struct coro *)mg->mg_ptr;
754 mg->mg_ptr = 0; 835 mg->mg_ptr = 0;
755 836
756 coro_state_destroy (coro); 837 coro_state_destroy (coro);
757 838
758 return 0; 839 return 0;
759} 840}
760 841
761static int 842static int
762coro_state_dup (MAGIC *mg, CLONE_PARAMS *params) 843coro_state_dup (pTHX_ MAGIC *mg, CLONE_PARAMS *params)
763{ 844{
764 struct coro *coro = (struct coro *)mg->mg_ptr; 845 struct coro *coro = (struct coro *)mg->mg_ptr;
765 846
766 ++coro->refcnt; 847 ++coro->refcnt;
767 848
768 return 0; 849 return 0;
769} 850}
770 851
771static MGVTBL coro_state_vtbl = { 0, 0, 0, 0, coro_state_clear, 0, coro_state_dup, 0 }; 852static MGVTBL coro_state_vtbl = {
853 0, 0, 0, 0,
854 coro_state_clear,
855 0,
856#ifdef MGf_DUP
857 coro_state_dup,
858#else
859# define MGf_DUP 0
860#endif
861};
772 862
773static struct coro * 863static struct coro *
774SvSTATE (SV *coro) 864SvSTATE (SV *coro)
775{ 865{
776 HV *stash; 866 HV *stash;
791 assert (mg->mg_type == PERL_MAGIC_ext); 881 assert (mg->mg_type == PERL_MAGIC_ext);
792 return (struct coro *)mg->mg_ptr; 882 return (struct coro *)mg->mg_ptr;
793} 883}
794 884
795static void 885static void
886prepare_transfer (struct transfer_args *ta, SV *prev, SV *next, int flags)
887{
888 ta->prev = SvSTATE (prev);
889 ta->next = SvSTATE (next);
890 ta->flags = flags;
891}
892
893static void
796api_transfer (pTHX_ SV *prev, SV *next, int flags) 894api_transfer (SV *prev, SV *next, int flags)
797{ 895{
798 coro_state_transfer (aTHX_ SvSTATE (prev), SvSTATE (next), flags); 896 dTHX;
897 struct transfer_args ta;
898
899 prepare_transfer (&ta, prev, next, flags);
900 TRANSFER (ta);
799} 901}
800 902
801/** Coro ********************************************************************/ 903/** Coro ********************************************************************/
802 904
803#define PRIO_MAX 3 905#define PRIO_MAX 3
811static GV *coro_current, *coro_idle; 913static GV *coro_current, *coro_idle;
812static AV *coro_ready [PRIO_MAX-PRIO_MIN+1]; 914static AV *coro_ready [PRIO_MAX-PRIO_MIN+1];
813static int coro_nready; 915static int coro_nready;
814 916
815static void 917static void
816coro_enq (pTHX_ SV *sv) 918coro_enq (SV *sv)
817{ 919{
818 int prio; 920 int prio;
819 921
820 if (SvTYPE (sv) != SVt_PVHV) 922 if (SvTYPE (sv) != SVt_PVHV)
821 croak ("Coro::ready tried to enqueue something that is not a coroutine"); 923 croak ("Coro::ready tried to enqueue something that is not a coroutine");
825 av_push (coro_ready [prio - PRIO_MIN], sv); 927 av_push (coro_ready [prio - PRIO_MIN], sv);
826 coro_nready++; 928 coro_nready++;
827} 929}
828 930
829static SV * 931static SV *
830coro_deq (pTHX_ int min_prio) 932coro_deq (int min_prio)
831{ 933{
832 int prio = PRIO_MAX - PRIO_MIN; 934 int prio = PRIO_MAX - PRIO_MIN;
833 935
834 min_prio -= PRIO_MIN; 936 min_prio -= PRIO_MIN;
835 if (min_prio < 0) 937 if (min_prio < 0)
852 954
853 if (SvROK (coro)) 955 if (SvROK (coro))
854 coro = SvRV (coro); 956 coro = SvRV (coro);
855 957
856 LOCK; 958 LOCK;
857 coro_enq (aTHX_ SvREFCNT_inc (coro)); 959 coro_enq (SvREFCNT_inc (coro));
858 UNLOCK; 960 UNLOCK;
859} 961}
860 962
861static void 963static void
862api_schedule (void) 964prepare_schedule (struct transfer_args *ta)
863{ 965{
864 dTHX;
865
866 SV *prev, *next; 966 SV *current, *prev, *next;
967
867 SV *current = GvSV (coro_current); 968 current = GvSV (coro_current);
868 969
869 for (;;) 970 for (;;)
870 { 971 {
871 LOCK; 972 LOCK;
872
873 next = coro_deq (aTHX_ PRIO_MIN); 973 next = coro_deq (PRIO_MIN);
974 UNLOCK;
874 975
875 if (next) 976 if (next)
876 break; 977 break;
877
878 UNLOCK;
879 978
880 { 979 {
881 dSP; 980 dSP;
882 981
883 ENTER; 982 ENTER;
894 993
895 prev = SvRV (current); 994 prev = SvRV (current);
896 SvRV (current) = next; 995 SvRV (current) = next;
897 996
898 /* free this only after the transfer */ 997 /* free this only after the transfer */
998 LOCK;
999 free_coro_mortal ();
1000 UNLOCK;
899 coro_mortal = prev; 1001 coro_mortal = prev;
900 1002
1003 ta->prev = SvSTATE (prev);
1004 ta->next = SvSTATE (next);
1005 ta->flags = TRANSFER_SAVE_ALL;
1006}
1007
1008static void
1009prepare_cede (struct transfer_args *ta)
1010{
1011 LOCK;
1012 coro_enq (SvREFCNT_inc (SvRV (GvSV (coro_current))));
901 UNLOCK; 1013 UNLOCK;
902 1014
903 coro_state_transfer (aTHX_ SvSTATE (prev), SvSTATE (next), TRANSFER_SAVE_ALL); 1015 prepare_schedule (ta);
904} 1016}
905 1017
906static int coro_cede_self; 1018static void
1019api_schedule (void)
1020{
1021 dTHX;
1022 struct transfer_args ta;
1023
1024 prepare_schedule (&ta);
1025 TRANSFER (ta);
1026}
907 1027
908static void 1028static void
909api_cede (void) 1029api_cede (void)
910{ 1030{
911 dTHX; 1031 dTHX;
912 SV *current = SvREFCNT_inc (SvRV (GvSV (coro_current))); 1032 struct transfer_args ta;
913 1033
914 LOCK; 1034 prepare_cede (&ta);
915 1035 TRANSFER (ta);
916 if (coro_cede_self)
917 {
918 AV *runqueue = coro_ready [PRIO_MAX - PRIO_MIN];
919 av_unshift (runqueue, 1);
920 av_store (runqueue, 0, current);
921 coro_nready++;
922 coro_cede_self = 0;
923 }
924 else
925 coro_enq (aTHX_ current);
926
927 UNLOCK;
928
929 api_schedule ();
930} 1036}
931 1037
932MODULE = Coro::State PACKAGE = Coro::State 1038MODULE = Coro::State PACKAGE = Coro::State
933 1039
934PROTOTYPES: DISABLE 1040PROTOTYPES: DISABLE
949 main_mainstack = PL_mainstack; 1055 main_mainstack = PL_mainstack;
950 1056
951 coroapi.ver = CORO_API_VERSION; 1057 coroapi.ver = CORO_API_VERSION;
952 coroapi.transfer = api_transfer; 1058 coroapi.transfer = api_transfer;
953 1059
954 Newz (0, main_stack, 1, coro_stack);
955 main_stack->idle_sp = (void *)-1;
956
957 assert (("PRIO_NORMAL must be 0", !PRIO_NORMAL)); 1060 assert (("PRIO_NORMAL must be 0", !PRIO_NORMAL));
958} 1061}
959 1062
960SV * 1063SV *
961new (char *klass, ...) 1064new (char *klass, ...)
970 1073
971 hv = newHV (); 1074 hv = newHV ();
972 sv_magicext ((SV *)hv, 0, PERL_MAGIC_ext, &coro_state_vtbl, (char *)coro, 0)->mg_flags |= MGf_DUP; 1075 sv_magicext ((SV *)hv, 0, PERL_MAGIC_ext, &coro_state_vtbl, (char *)coro, 0)->mg_flags |= MGf_DUP;
973 RETVAL = sv_bless (newRV_noinc ((SV *)hv), gv_stashpv (klass, 1)); 1076 RETVAL = sv_bless (newRV_noinc ((SV *)hv), gv_stashpv (klass, 1));
974 1077
975 av_push (coro->args, newSVsv (RETVAL));
976 for (i = 1; i < items; i++) 1078 for (i = 1; i < items; i++)
977 av_push (coro->args, newSVsv (ST (i))); 1079 av_push (coro->args, newSVsv (ST (i)));
978 1080
979 coro->stack = main_stack;
980 /*coro->mainstack = 0; *//*actual work is done inside transfer */ 1081 /*coro->mainstack = 0; *//*actual work is done inside transfer */
981 /*coro->stack = 0;*/ 1082 /*coro->stack = 0;*/
982} 1083}
983 OUTPUT: 1084 OUTPUT:
984 RETVAL 1085 RETVAL
985 1086
986void 1087void
987transfer (prev, next, flags) 1088_set_stacklevel (...)
988 SV *prev 1089 ALIAS:
989 SV *next 1090 Coro::State::transfer = 1
990 int flags 1091 Coro::schedule = 2
1092 Coro::cede = 3
1093 Coro::Cont::yield = 4
991 CODE: 1094 CODE:
992 PUTBACK;
993 coro_state_transfer (aTHX_ SvSTATE (prev), SvSTATE (next), flags);
994 SPAGAIN;
995
996int
997prio (Coro::State coro, int newprio = 0)
998 ALIAS:
999 nice = 1
1000 CODE:
1001{ 1095{
1002 RETVAL = coro->prio; 1096 struct transfer_args ta;
1003 1097
1004 if (items > 1) 1098 switch (ix)
1005 { 1099 {
1100 case 0:
1101 ta.prev = (struct coro *)INT2PTR (coro_stack *, SvIV (ST (0)));
1102 ta.next = 0;
1103 ta.flags = TRANSFER_SET_STACKLEVEL;
1104 break;
1105
1106 case 1:
1006 if (ix) 1107 if (items != 3)
1007 newprio += coro->prio; 1108 croak ("Coro::State::transfer(prev,next,flags) expects three arguments, not %d", items);
1008 1109
1009 if (newprio < PRIO_MIN) newprio = PRIO_MIN; 1110 prepare_transfer (&ta, ST (0), ST (1), SvIV (ST (2)));
1010 if (newprio > PRIO_MAX) newprio = PRIO_MAX; 1111 break;
1011 1112
1012 coro->prio = newprio; 1113 case 2:
1114 prepare_schedule (&ta);
1115 break;
1116
1117 case 3:
1118 prepare_cede (&ta);
1119 break;
1120
1121 case 4:
1122 {
1123 SV *yieldstack;
1124 SV *sv;
1125 AV *defav = GvAV (PL_defgv);
1126
1127 yieldstack = *hv_fetch (
1128 (HV *)SvRV (GvSV (coro_current)),
1129 "yieldstack", sizeof ("yieldstack") - 1,
1130 0
1131 );
1132
1133 /* set up @_ -- ugly */
1134 av_clear (defav);
1135 av_fill (defav, items - 1);
1136 while (items--)
1137 av_store (defav, items, SvREFCNT_inc (ST(items)));
1138
1139 sv = av_pop ((AV *)SvRV (yieldstack));
1140 ta.prev = SvSTATE (*av_fetch ((AV *)SvRV (sv), 0, 0));
1141 ta.next = SvSTATE (*av_fetch ((AV *)SvRV (sv), 1, 0));
1142 ta.flags = 0;
1143 SvREFCNT_dec (sv);
1144 }
1145 break;
1146
1013 } 1147 }
1014}
1015 1148
1016void 1149 TRANSFER (ta);
1017_clear_idle_sp (Coro::State self) 1150}
1018 CODE:
1019 self->stack->idle_sp = 0;
1020 1151
1021void 1152void
1022_clone_state_from (SV *dst, SV *src) 1153_clone_state_from (SV *dst, SV *src)
1023 CODE: 1154 CODE:
1024{ 1155{
1035 int code 1166 int code
1036 PROTOTYPE: $ 1167 PROTOTYPE: $
1037 CODE: 1168 CODE:
1038 _exit (code); 1169 _exit (code);
1039 1170
1040MODULE = Coro::State PACKAGE = Coro::Cont
1041
1042void
1043yield (...)
1044 PROTOTYPE: @
1045 CODE:
1046{
1047 SV *yieldstack;
1048 SV *sv;
1049 AV *defav = GvAV (PL_defgv);
1050 struct coro *prev, *next;
1051
1052 yieldstack = *hv_fetch (
1053 (HV *)SvRV (GvSV (coro_current)),
1054 "yieldstack", sizeof ("yieldstack") - 1,
1055 0
1056 );
1057
1058 /* set up @_ -- ugly */
1059 av_clear (defav);
1060 av_fill (defav, items - 1);
1061 while (items--)
1062 av_store (defav, items, SvREFCNT_inc (ST(items)));
1063
1064 sv = av_pop ((AV *)SvRV (yieldstack));
1065 prev = SvSTATE (*av_fetch ((AV *)SvRV (sv), 0, 0));
1066 next = SvSTATE (*av_fetch ((AV *)SvRV (sv), 1, 0));
1067 SvREFCNT_dec (sv);
1068
1069 coro_state_transfer (aTHX_ prev, next, 0);
1070}
1071
1072MODULE = Coro::State PACKAGE = Coro 1171MODULE = Coro::State PACKAGE = Coro
1073 1172
1074BOOT: 1173BOOT:
1075{ 1174{
1076 int i; 1175 int i;
1101 1200
1102 GCoroAPI = &coroapi; 1201 GCoroAPI = &coroapi;
1103 sv_setiv (sv, (IV)&coroapi); 1202 sv_setiv (sv, (IV)&coroapi);
1104 SvREADONLY_on (sv); 1203 SvREADONLY_on (sv);
1105 } 1204 }
1205}
1206
1207int
1208prio (Coro::State coro, int newprio = 0)
1209 ALIAS:
1210 nice = 1
1211 CODE:
1212{
1213 RETVAL = coro->prio;
1214
1215 if (items > 1)
1216 {
1217 if (ix)
1218 newprio += coro->prio;
1219
1220 if (newprio < PRIO_MIN) newprio = PRIO_MIN;
1221 if (newprio > PRIO_MAX) newprio = PRIO_MAX;
1222
1223 coro->prio = newprio;
1224 }
1106} 1225}
1107 1226
1108void 1227void
1109ready (SV *self) 1228ready (SV *self)
1110 PROTOTYPE: $ 1229 PROTOTYPE: $
1117 CODE: 1236 CODE:
1118 RETVAL = coro_nready; 1237 RETVAL = coro_nready;
1119 OUTPUT: 1238 OUTPUT:
1120 RETVAL 1239 RETVAL
1121 1240
1122void
1123schedule (...)
1124 PROTOTYPE:
1125 CODE:
1126 api_schedule ();
1127
1128void
1129_set_cede_self ()
1130 CODE:
1131 coro_cede_self = 1;
1132
1133void
1134cede (...)
1135 PROTOTYPE:
1136 CODE:
1137 api_cede ();
1138
1139MODULE = Coro::State PACKAGE = Coro::AIO 1241MODULE = Coro::State PACKAGE = Coro::AIO
1140 1242
1141SV * 1243SV *
1142_get_state () 1244_get_state ()
1143 CODE: 1245 CODE:

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines